Work object not defined

[eshu153]

Hi,


I am trying to search a 4 strings in a column against each website in another column of 4 websites. I want the column range to be assigned to a variable and result in a new column. But this is giving error. Any suggestions please?




Option Explicit


Sub LookForText()
Dim rngURL As Range
Dim cll As Range
Dim stCheck As Range
Dim xmlHttp As Object
Dim currentWorksheet As Worksheet
On Error Resume Next
Set xmlHttp = CreateObject("Microsoft.XMLHTTP")
If xmlHttp Is Nothing Then
MsgBox "Unable to create XMLHTTP object, it's probably not installed on this machine", vbCritical
Exit Sub
End If

Set rngURL = Application.InputBox("Select the range of URLs to check", "Select Range", Selection, Type:=8)
On Error GoTo 0

If rngURL Is Nothing Then Exit Sub

Set stCheck = currentWorksheet.Range("H2", "H5")

If Len(stCheck) = 0 Then Exit Sub

For Each cll In rngURL.Cells
If CheckURL(xmlHttp, cll.Value, stCheck) Then
cll.Offset(, 1).Value = 1
End If
Next cll

End Sub

Private Function CheckURL(ByRef xmlHttp As Object, ByVal URL As String, ByVal stCheck As String) As Boolean
Dim stResult As String

If Not LCase$(URL) Like "http://*" Then
URL = "http://" & URL
End If

xmlHttp.Open "GET", URL, False
xmlHttp.Send ""

If xmlHttp.readyState = 4 Then
If xmlHttp.Status = 200 Then
stResult = xmlHttp.responseText

If InStr(1, stResult, stCheck, vbBinaryCompare) > 0 Then
CheckURL = True
End If
End If
End If
End Function
[FONT=Tahoma, Calibri, Verdana, Geneva, sans-serif]
[/FONT]