I have been a long time lurker on this site and I appreciate everything that I have learned from each of your responses that I have seen. Now I am looking to efficiently run through a code that I have written with your help.
Problem 1- Page shows as 'not responding' while running the code. This happens about 4 times every time it is ran. Also, I am getting the data in about 1 minute and 40 seconds. My company doesn't have the best internet so that may be why it takes so long.
Problem 2- Is there a better methodology of running through a loop, to where the code is on a singular macro, rather than in 10 separate macros. My site only changes a four letter portion within the URL(shown as DYNAMICPORTION in the 2nd code below. I have tried to loop it with a URL that refers to a range, but cant figure out how to have it place this information on a new worksheet within the loop.
Any help would be appreciated! Thanks again!
Main Macro
Sub GetAllData()
Dim t As Date
t = Now()
Application.Calculation = xlManual
Application.StatusBar = "Gathering Data 10%"
GetSiteData
Application.StatusBar = "Gathering Data 20%"
GetSite2Data
Application.StatusBar = "Gathering Data 30%"
GetSite3Data
Application.StatusBar = "Gathering Data 40%"
GetSite4Data
Application.StatusBar = "Gathering Data 50%"
GetSite5Data
Application.StatusBar = "Gathering Data 60%"
GetSite6Data
Application.StatusBar = "Gathering Data 70%"
GetSite7Data
Application.StatusBar = "Gathering Data 80%"
GetSite8Data
Application.StatusBar = "Gathering Data 90%"
GetSite9Data
Application.StatusBar = "Gathering Data 100%"
GetSite10Data
Application.Calculation = xlAutomatic
Application.StatusBar = Ready
MsgBox "It took " & Format(Now() - t, "hh:mm:ss") & " to gather the site's data!" & vbNewLine & "Please allow a minute to calculate!"
End Sub
Macro under the main
Sub GetSiteData()
Dim XMLRequest As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim HTMLTable As MSHTML.IHTMLElement
Dim HTMLTable2 As MSHTML.IHTMLElement
Dim TableRow As MSHTML.IHTMLElement
Dim TableCell As MSHTML.IHTMLElement
Dim RowNum As Long, ColNum As Long
Dim url As String: url = "https://thewebsite/theproduct/isextracted/index.cfm?site=DYNAMICPORTION&type=data"
Dim OutputSheet As Worksheet
Set OutputSheet = ThisWorkbook.Worksheets("Site")
OutputSheet.Cells.ClearContents
XMLRequest.Open "GET", url, False
XMLRequest.send
Do While XMLRequest.readyState <> 4
DoEvents
Loop
HTMLDoc.body.innerHTML = XMLRequest.responseText
Set HTMLTable = HTMLDoc.getElementById("TAB7")
Set HTMLTable2 = HTMLDoc.getElementById("TAB5")
RowNum = 0
ColNum = 0
For Each TableRow In HTMLTable.getElementsByTagName("tr")
RowNum = RowNum + 1
For Each TableCell In TableRow.Children
ColNum = ColNum + 1
OutputSheet.Cells(RowNum, ColNum).Value = TableCell.innerText
Next TableCell
ColNum = 0
Next TableRow
For Each TableRow In HTMLTable2.getElementsByTagName("tr")
RowNum = RowNum + 1
For Each TableCell In TableRow.Children
ColNum = ColNum + 1
OutputSheet.Cells(RowNum, ColNum).Value = TableCell.innerText
Next TableCell
ColNum = 0
Next TableRow
End Sub