Excel VBA - Improve the speed of this code

Question

I need to speed up the following code. I have been trying to improve it for weeks, my problem is that I am very limited in VBA and this was the best I could write, so far. Although it works it is very slow with IE as it has to close IE and then reopen it to place a new search criteria in it.

I was trying to write it to use XMLHTTP, but could not get it to work. The only way I COULD get it to add a new search criteria was to close down IE and then reopen it, which makes it very slow.

BACKGROUND

I have 2 sheets in my workbook

In Sheet1 I extracted results go in to column A and B row2 down. In A2 is the URL to Search and in B2 is the item to be searched

In Sheet2 column A I have a list of Search criteria, which is copied to Sheet1 B2, after each search is completed, the word "Done" is placed next to the completed search criteria.

When the code it run, it select a search criteria and places it into IE as it opens, the items i searched extracted and then it closes IE and on reopening IE it loads the next search item into it from Sheet2 Column A.

Not the best code, but works and needs improving.

Private Sub CommandButton5_Click()
  
Dim Html As htmlDocument
Dim objIE As Object
Dim result As String
Dim pageNumber As Long
Dim nextPageElement As Object
Dim HtmlText As Variant
Dim wsSheet As Worksheet 
Dim wb As Workbook
Dim sht As Worksheet

        Set wb = ThisWorkbook
            Set wsSheet = wb.Sheets("Sheet1")
            Set sht = ThisWorkbook.Worksheets("Sheet1")
            

        Set objIE = New InternetExplorer
            objIE.Visible = True
            objIE.navigate Sheets("Sheet1").Range("A2").Value & Replace(Worksheets("Sheet1").Range("B2").Value, " ", "+")
        Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents:
        Loop
        
        Set Html = objIE.document
            Set elements = Html.getElementsByClassName("s-item__wrapper clearfix") ' parent CLASS
        For Each element In elements
            DoEvents

''' Element 1
        If element.getElementsByClassName("s-item__link")(0) Is Nothing Then
            wsSheet.Cells(sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = "-"
        Else
            HtmlText = element.getElementsByClassName("s-item__link")(0).href
            wsSheet.Cells(sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = HtmlText
        End If
'''' Element 2
        If element.getElementsByClassName("s-item__seller-info-icon")(0) Is Nothing Then
            wsSheet.Cells(sht.Cells(sht.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = "-"
        Else
            HtmlText = element.getElementsByClassName("s-item__seller-info-icon")(0).href
            wsSheet.Cells(sht.Cells(sht.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = HtmlText
        End If

        Next element

        Do
' Searches Number of Pages
            If pageNumber >= 1 Then Exit Do
                Set nextPageElement = Html.getElementsByClassName("pagination__next")(0) ' CLICK TO NEXT PAGE
            If nextPageElement Is Nothing Then Exit Do
                nextPageElement.Click 'next web page
            Do While objIE.Busy = True Or objIE.readyState <> 4
        Loop
           ' Set Html = objIE.document
                pageNumber = pageNumber + 0
         
Loop

        objIE.Quit
            Set objIE = Nothing
            Set Html = Nothing
            Set nextPageElement = Nothing
            Set HtmlText = Nothing
            Set element = Nothing
            
'delete duplicates in column b
        Range("$B$1").CurrentRegion.RemoveDuplicates Columns:=2, Header:=xlYes


        
'********** Copy and paste each item from sheet2 column A to sheet1 B2 ********
        With Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, -1)
            If .Value <> "" Then
               .Copy Sheets("Sheet1").[B2]
               .Offset(, 1).Value = "Done" ' when an item has been searched the word "Done" is placed next to it in Sheet2
            Else
                Exit Sub
            End If
        End With
 
 Call RestartLoop_Click

End Sub

Then This is Called

Private Sub RestartLoop_Click()
Call IE_Sledgehammer ' Ensure Browser is closed
    Application.Wait (Now + TimeValue("0:00:01"))
    CommandButton5.Value = True ' click command button 5 and run the process again
End Sub

Sub IE_Sledgehammer()
'THIS ensure IE browser is closed
    On Error Resume Next
    Dim objWMI As Object, objProcess As Object, objProcesses As Object
    Set objWMI = GetObject("winmgmts://.")
    Set objProcesses = objWMI.ExecQuery( _
        "SELECT * FROM Win32_Process WHERE Name = 'iexplore.exe'")
    For Each objProcess In objProcesses
        Call objProcess.Terminate
    Next
    Set objProcesses = Nothing: Set objWMI = Nothing
    On Error GoTo 0
End Sub

Any guidance on how to improve it will help, this was the only way I could get it to work, due to my experience. I have been researching this on the web but could not find any help on how to search multiple search criteria automatically. All I could find was how to search on item and the place a new search item.

Thanks for having a look.