DanOfEarth
07-07-2010, 04:13 AM
On my "Address List" web crawler query that searches Yellowpages.com for people's phone numbers, it successfully downloads the web search page onto a spreadsheet and finds/matches a person's Last Name off of it. And I know the "phone number" data is always exactly three cells below that cell. Using the below subroutine, I'm trying to Copy that data "three cells below" without using the "Offset.Activate" method.name. I hope the code below is understandable.
The red part commented out is feeble attempts to "define the name" of the cell so I can work with it.
Help please....been stuck on it for four days. The "Google police" are going to show up at my door step and tell me to "cut it out". :banghead:
Sub TestParser()
Application.ScreenUpdating = False
Dim rngFound As Range, rngToTest As Range
Dim sFirstAddress As String
Dim LastName As Range
' This sets the LastName of the person we are searching for on the Yellowpages.com
' The below Active sheet/cell is off of our Address List
With Sheets("Scrub")
Set LastName = ActiveCell.Offset(0, 2)
End With
' We've already imported the data we need onto the Import2 sheet. We need to search it for
' the above LastName we are looking for
With Sheets("Import2").Range("A139:A200")
Set rngFound = .Find( _
What:=LastName, _
Lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
' This confirms that we found the LastName successfully
If Not rngFound Is Nothing Then
Set rngToTest = rngFound
' The below offsets down three cells and captures the phone number....neither of the two below are working
MyPhoneNumber = Range("rngToTest").Offset(3, 0).Value
Set MyRange = Range(rngToTest, rngToTest.Offset(3, 0))
'Note the address of the first found cell so we know where we started.
sFirstAddress = rngFound.Address
'I have no earthly idea what the next FindNext and loop does....oh well
Set rngFound = .FindNext(After:=rngFound)
Do Until rngFound.Address = sFirstAddress
Set rngToTest = Union(rngToTest, rngFound)
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With
Application.ScreenUpdating = True
End Sub
The red part commented out is feeble attempts to "define the name" of the cell so I can work with it.
Help please....been stuck on it for four days. The "Google police" are going to show up at my door step and tell me to "cut it out". :banghead:
Sub TestParser()
Application.ScreenUpdating = False
Dim rngFound As Range, rngToTest As Range
Dim sFirstAddress As String
Dim LastName As Range
' This sets the LastName of the person we are searching for on the Yellowpages.com
' The below Active sheet/cell is off of our Address List
With Sheets("Scrub")
Set LastName = ActiveCell.Offset(0, 2)
End With
' We've already imported the data we need onto the Import2 sheet. We need to search it for
' the above LastName we are looking for
With Sheets("Import2").Range("A139:A200")
Set rngFound = .Find( _
What:=LastName, _
Lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
' This confirms that we found the LastName successfully
If Not rngFound Is Nothing Then
Set rngToTest = rngFound
' The below offsets down three cells and captures the phone number....neither of the two below are working
MyPhoneNumber = Range("rngToTest").Offset(3, 0).Value
Set MyRange = Range(rngToTest, rngToTest.Offset(3, 0))
'Note the address of the first found cell so we know where we started.
sFirstAddress = rngFound.Address
'I have no earthly idea what the next FindNext and loop does....oh well
Set rngFound = .FindNext(After:=rngFound)
Do Until rngFound.Address = sFirstAddress
Set rngToTest = Union(rngToTest, rngFound)
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With
Application.ScreenUpdating = True
End Sub