You could copy the table outerHTML to the clipboard and paste that to Excel. It is nice, easy and quick.
Option Explicit
Public Sub GetInfo()
Dim IE As New InternetExplorer
Dim nameList As String
nameList = "Anderson, Kelly" & Chr$(10) & "Jones, Robert"
With IE
.Visible = True
.navigate "https://hdmaster.net/MP/MP_Public"
While .Busy Or .readyState < 4: DoEvents: Wend
With .document
.querySelector("[name=SearchFor]").Value = nameList
.querySelector("#search").Click
End With
While .Busy Or .readyState < 4: DoEvents: Wend
Dim clipboard As Object
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
clipboard.SetText .document.querySelector(".newTable").outerHTML
clipboard.PutInClipboard
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).PasteSpecial
.Quit
End With
End Sub
References (VBE > Tools > References):
- Microsoft HTML Object Library
- Microsoft Internet Controls
Your code version of the above:
Public Sub Input_And_Return()
Dim ieApp As Object: Set ieApp = New InternetExplorer
Dim ieDoc As Object
With ieApp
.Visible = True
.navigate "https://hdmaster.net/MP/MP_Public"
While .Busy Or .readyState < 4: DoEvents: Wend
With .document.forms(0)
.SearchFor.Value = "Anderson, Kelly" & Chr$(10) & "Jones, Robert"
.submit
Dim clipboard As Object
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
clipboard.SetText .getElementsByClassName("newTable")(0).outerHTML
clipboard.PutInClipboard
End With
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).PasteSpecial
.Quit
End With
End Sub
Or by looping rows and columns of the table:
Public Sub Input_And_Return()
Dim ieApp As Object, ieDoc As Object
Set ieApp = New InternetExplorer
With ieApp
.Visible = True
.navigate "https://hdmaster.net/MP/MP_Public"
While .Busy Or .readyState < 4: DoEvents: Wend
With .document.forms(0)
.SearchFor.Value = "Anderson, Kelly" & Chr$(10) & "Jones, Robert"
.submit
Dim r As Long, c As Long, tr As Object, td As Object
With .getElementsByClassName("newTable")(0)
For Each tr In .getElementsByTagName("tr")
r = r + 1: c = 1
For Each td In tr.getElementsByTagName("td")
Cells(r, c).Value = td.innerText
c = c + 1
Next td
Next tr
End With
End With
.Quit
End With
End Sub
Output:
EDIT:
Some ugly code to get the short ids
Option Explicit
Public Sub Input_And_Return()
Dim ieApp As Object, ieDoc As Object
Set ieApp = New InternetExplorer
With ieApp
.Visible = True
.navigate "https://hdmaster.net/MP/MP_Public"
While .Busy Or .readyState < 4: DoEvents: Wend
With .document.forms(0)
.SearchFor.Value = "Anderson, Kelly" & Chr$(10) & "Jones, Robert"
.submit
Dim r As Long, c As Long, tr As Object, td As Object, hTable As Object, aNodeList As Object
Set hTable = .getElementsByClassName("newTable")(0)
Set aNodeList = .getElementsByClassName("newTable")(0).querySelectorAll("[align=center][onclick*='javascript:rowClick']")
Dim idDict As Object, i As Long, tempVal As Long
Set idDict = CreateObject("Scripting.Dictionary")
For i = 0 To aNodeList.Length - 1
tempVal = Split(Split(aNodeList.Item(i).onclick, "id=")(1), Chr$(39))(0)
If Not idDict.exists(tempVal) Then idDict.Add tempVal, vbNullString
Next i
With hTable
For Each tr In .getElementsByTagName("tr")
r = r + 1: c = 1
For Each td In tr.getElementsByTagName("td")
Cells(r, c).Value = td.innerText
c = c + 1
Next td
Next tr
If idDict.Count = r - 1 Then Cells(2, c).Resize(idDict.Count, 1) = Application.WorksheetFunction.Transpose(idDict.keys)
End With
End With
.Quit
End With
End Sub