For my work, I regularly need to compare a table of ~2000 meds to a website to see whether their substance IDs (an 8-digit number) still exist / have changed. I tried to automate the process using VBA (allowed at work because it comes with excel) and xmlhttprequests. I got it to work, but the process is ever so slow (sometimes excel freezes for up to 10 minutes) and I want to speed things up. Mind you, I'm only an amateur and not a programmer.
This is my code:
Sub PZN_Check_XHR()
Dim xmlhttp As Object
Dim url As String
Dim pzn As String
Dim ZelleA As Range
Dim ZelleB As Range
Dim a As Range
Set a = Worksheets("Treatments").Range("H2:H"& Cells(Rows.Count, "H").End(xlUp).Row)
Set xmlhttp = CreateObject("MSXML2.serverXMLHTTP")
'Begin Loop, define PZN (substance IDs), define cells
For Each ZelleA In a
pzn = ZelleA.Value
Set ZelleB = Cells(ZelleA.Row, 10)
Set ZelleC = Cells(ZelleA.Row, 8)
'Add a link to our intranet database for all the substance IDs in Column H)
If ZelleC.Value <> 0 Then
ZelleC.Hyperlinks.Add Anchor:=ZelleC, Address:="http://ukb648/list.php?st="& pzn & "&aufruf=1"
End If
'URL of the website I want to check
url = "https://www.arzneimittel-datenbank.de/search/"& pzn
xmlhttp.Open "GET", url, True
xmlhttp.Send
Do While xmlhttp.readyState <> 4
DoEvents
Loop
If InStr(1, xmlhttp.responseText, "<title>Arzneimittel-Datenbank") <> 0 Then
ZelleB.Interior.ColorIndex = 3
ZelleB.Value = "PZN not found"
ZelleB.Hyperlinks.Add Anchor:=ZelleB, Address:="http://ukb648/list.php?st="& Left$(Worksheets("Treatments").Cells(ZelleA.Row, 2), InStr(1, Worksheets("Treatments").Cells(ZelleA.Row, 2), ""))
Else
'Print result to ZelleB
ZelleB = Mid(xmlhttp.responseText, InStr(1, xmlhttp.responseText, "<title>") + 7, (InStr(1, xmlhttp.responseText, "</title>") - InStr(1, xmlhttp.responseText, "<title>") - 32))
ZelleB.Interior.ColorIndex = 4
Worksheets("Treatments").Cells(ZelleA.Row, 11) = Worksheets("TradeNames").Cells(ZelleA.Row, 3)
Worksheets("Treatments").Cells(ZelleA.Row, 12) = Worksheets("TradeNames").Cells(ZelleA.Row, 5)
End If
Next ZelleA
End Sub
This code takes about 1-2 seconds per row to execute, and my table has about 2000 rows (and will grow to >10.000 rows in the forseeable future). Is there a way to speed this up? Maybe reading the data into an array first, and work from there? If yes, how so? Or did I screw up the loop somehow? Thank you so much for your time!