Help with checking search results on a website

Option Explicit

Sub Check_URLS()
Dim i           As Long
Dim xResult     As String
Dim xCell       As Range
Dim xLast_Row   As Long

Sheets("Check URL's").Activate

xLast_Row = Range("A1").SpecialCells(xlLastCell).Row

If xLast_Row < 2 Then
    MsgBox ("No data found - run cancelled.")
    Exit Sub
End If

Range("B2:B" & xLast_Row).ClearContents

For Each xCell In Range("A2:A" & xLast_Row)
    
    If xCell <> "" Then
        i = i + 1
        xResult = Get_URL(xCell.Value)
    Else
        xResult = "N/A"
    End If
    
    xCell.Offset(0, 1) = xResult
    
    Application.ScreenUpdating = True
    
Next

End Sub

Function Get_URL(xUrl As String)
Dim xTempSheet  As Worksheet
Dim xConnection As String
Dim xFound      As Range

Application.ScreenUpdating = False

Set xTempSheet = Sheets.Add
xConnection = "x" & Format(Now(), "hhmmss")

On Error Resume Next

    With xTempSheet.QueryTables.Add(Connection:="URL;" & xUrl, Destination:=Range("$A$1"))
        .Name = xConnection
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

On Error GoTo 0
Dim fred
Set fred = xTempSheet.QueryTables(1)

If xTempSheet.Range("A1").SpecialCells(xlLastCell).Row = 1 Then
    Application.DisplayAlerts = False
        xTempSheet.Delete
    Application.DisplayAlerts = True
    Get_URL = "N/A"
    Exit Function
End If

Set xFound = xTempSheet.Range("A:A").Find(What:="Your search yielded no results", LookIn:=xlFormulas, LookAt:=xlPart _
                , SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        
If xFound Is Nothing Then
    Get_URL = "False"
Else
    Get_URL = "True"
End If

Application.DisplayAlerts = False
    xTempSheet.Delete
Application.DisplayAlerts = True

End Function

Select all Open in new window