Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 90280

How can I speed up xmlhttp requests (VBA)? Should I be using arrays?

$
0
0

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!


Viewing all articles
Browse latest Browse all 90280

Trending Articles