Work object not defined

eshu153

New Member
Joined
Jun 3, 2017
Messages
8
I am trying to search a string from a website using VBA. I 4 websites in one column and 4 search strings in another column. I need to assign the column range to variables which was giving error object not defined. Any suggestions please
Here is the code am using.

Code:
Option Explicit
[COLOR=#ff0000]
Sub LookForText()[/COLOR]
    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

't


[COLOR=#ff0000]Sub LookForText()[/COLOR]
    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
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

mole999

Moderator
Joined
Oct 23, 2004
Messages
10,524
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
when you compile it, excel warns that the two I have highlighted in RED are duplicates

I think your intention was to post once which would provide

Code:
Option Explicit
[COLOR=#ff0000]
Sub LookForText()[/COLOR]
    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
 
Last edited:

eshu153

New Member
Joined
Jun 3, 2017
Messages
8
By mistake i have copied it twice. But in real VBA editor it's not duplicated. Now I guess you can suggest me.
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,271
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

I'll suggest something, you never set currentWorksheet to refer to anything.
 

eshu153

New Member
Joined
Jun 3, 2017
Messages
8
So, how will I achieve my target of using current sheet?

Is there any other way.
 

mole999

Moderator
Joined
Oct 23, 2004
Messages
10,524
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
activesheet.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,620
Messages
5,625,896
Members
416,141
Latest member
Bartek9q

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top