VBA throwing runtime error with new data in table

[Neasley]

Hello Everyone. This is my first time posting, but I hope someone can help because I am going batty.

I have attempted to use VBA to get Zip +4 zip codes from usps website. Everything was going fine with sample data, but when I copied new data into the table, I start getting a runtime 5 error: Invalid procedure call or argument.

Here is my data

[TABLE="width: 671"]
<colgroup><col><col><col><col span="2"><col></colgroup><tbody>[TR]
[TD]Address[/TD]
[TD]City[/TD]
[TD]State[/TD]
[TD]Zipcode[/TD]
[TD]Zip[/TD]
[TD]Zip4[/TD]
[/TR]
[TR]
[TD="align: right"]1642[/TD]
[TD]Harmon+Street[/TD]
[TD]Berkeley[/TD]
[TD]ca[/TD]
[TD]94703[/TD]
[TD]2636[/TD]
[/TR]
[TR]
[TD="align: right"]2[/TD]
[TD]Peabody+Terrace[/TD]
[TD]Cambridge[/TD]
[TD]ma[/TD]
[TD]02138[/TD]
[TD]6211[/TD]
[/TR]
[TR]
[TD="align: right"]1600[/TD]
[TD]Pennsylvania+Ave[/TD]
[TD]Washington[/TD]
[TD]DC[/TD]
[TD]20500[/TD]
[TD]0003[/TD]
[/TR]
[TR]
[TD="align: right"]1280[/TD]
[TD]N+Frontage+Rd+W[/TD]
[TD]Vail[/TD]
[TD]CO[/TD]
[TD]81657[/TD]
[TD]4457[/TD]
[/TR]
[TR]
[TD="align: right"]350[/TD]
[TD]5th+Ave[/TD]
[TD]New+York[/TD]
[TD]NY[/TD]
[TD]10118[/TD]
[TD]0110[/TD]
[/TR]
[TR]
[TD="align: right"]3[/TD]
[TD]Christine Dr[/TD]
[TD]Barrington [/TD]
[TD]RI[/TD]
[TD]02806[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]2100[/TD]
[TD]Channing+Way[/TD]
[TD]Berkeley[/TD]
[TD]CA[/TD]
[TD]94720[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]1642[/TD]
[TD]Harmon+Street[/TD]
[TD]Berkeley[/TD]
[TD]ca[/TD]
[TD]94703[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]2[/TD]
[TD]Peabody+Terrace[/TD]
[TD]Cambridge[/TD]
[TD]ma[/TD]
[TD]02138[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]1600[/TD]
[TD]Pennsylvania+Ave[/TD]
[TD]Washington[/TD]
[TD]DC[/TD]
[TD]20500[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]1280[/TD]
[TD]N+Frontage+Rd+W[/TD]
[TD]Vail[/TD]
[TD]CO[/TD]
[TD]81657[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]350[/TD]
[TD]5th+Ave[/TD]
[TD]New+York[/TD]
[TD]NY[/TD]
[TD]10118[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]1111[/TD]
[TD]S+Figueroa+St[/TD]
[TD]Los+Angeles[/TD]
[TD]CA[/TD]
[TD]90015[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]2100[/TD]
[TD]Channing+Way[/TD]
[TD]Berkeley[/TD]
[TD]CA[/TD]
[TD]94720[/TD]
[TD]

[/TD]
[/TR]
</tbody>[/TABLE]

My VBA code keeps stopping at the the 6th entry (3 Christine Dr Barrington RI 02806)

Sub ZipLookUp()
Dim URL As String, xmlHTTP As Object, html As Object, htmlResponse As String
Dim SStr As String, EStr As String, EndS As Integer, StartS As Integer
Dim Zip4Digit As String


Dim number As String
Dim address As String
Dim city As String
Dim state As String
Dim zipcode As String
Dim abc As String
Dim cell As Range


For Each cell In Range("C2:C15")
number = Sheet1.Range("A" & cell.Row)
address = Sheet1.Range("B" & cell.Row)
city = Sheet1.Range("C" & cell.Row)
state = Sheet1.Range("D" & cell.Row)
zipcode = Sheet1.Range("E" & cell.Row)


URL = "https://tools.usps.com/go/ZipLookupResultsAction!input.action?resultMode=1&companyName=&address1="
URL = URL & number & "+" & address & "&address2=&city=" & city & "&state=" & state & "&urbanCode=&postalCode=&zip=" & zipcode
Set xmlHTTP = CreateObject("MSXML2.XMLHTTP")
xmlHTTP.Open "GET", URL, False
On Error GoTo NoConnect
xmlHTTP.send
On Error GoTo 0
Set html = CreateObject("htmlfile")
htmlResponse = xmlHTTP.responseText
If htmlResponse = Null Then
MsgBox ("Aborted - HTML response was null")
GoTo End_Prog
End If


SStr = "<span class=""zip4"">": EStr = "</span><br />" 'Searches for a string within 2 strings
StartS = InStr(1, htmlResponse, SStr, vbTextCompare) + Len(SStr)
EndS = InStr(StartS, htmlResponse, EStr, vbTextCompare)
Zip4Digit = Left(Mid(htmlResponse, StartS, EndS - StartS), 4)


Sheet1.Range("F" & cell.Row).Value = Zip4Digit


GoTo End_Prog
NoConnect:
If Err = -2147467259 Or Err = -2146697211 Then MsgBox "Error - No Connection": GoTo End_Prog 'MsgBox Err & ": " & Error(Err)
End_Prog:
Next cell


the VBA runs as expected until I reach this entry, and then upon hitting the Sheet1 line, I get the arrow.

Can Someone help me please?

 

[Jon Peltier]

If these are both true:

SStr = "": EStr = ""

How can you extract the four digits? It's nonsensical to find a zero-length string within a longer string. StartS and EndS are both zero, and no +4 is returned. I suspect you didn't notice that since the column was partially populated.

I did get a response string from the query, but it was too much to read through to try to figure out what SStr and EStr should have been.

 

[brucef2112]

You're looping without delay.
Are you sure you aren't getting cut off by batch processing to the Post Office's zip lookup?
Hitting it too often will get you blocked.

that a side. you have these two vars empty. what are they suppose to find.
I see from the return html that the start string could be SStr = "class=""zip4"">"
And then change the zip4 fetch line to this Zip4Digit = Mid(htmlResponse, StartS, 4)

[COLOR=#ff0000]SStr = "": EStr = ""[/COLOR]
[COLOR=#333333]'Searches for a string within 2 strings[/COLOR]
[COLOR=#333333]StartS = InStr(1, htmlResponse, SStr, vbTextCompare) + Len(SStr)[/COLOR]
[COLOR=#333333]EndS = InStr(StartS, htmlResponse, EStr, vbTextCompare)[/COLOR]
[COLOR=#333333]Zip4Digit = Left(Mid(htmlResponse, StartS, EndS - StartS), 4)[/COLOR]

but i think youre getting cut off for batch proccessing.

 

[brucef2112]

I delay would be a wonderful thing, even better would be a random delay, so it looks more human.
And what if you have an address that returns multiple zip plus 4 ie the addresses missing a building number or a unit number.

 

[Neasley]

Brucef-

Your edits were exactly what I needed. I knew that I was getting cut off for batch processing, but I was just running a test. With your edits the VBA was able to process my problem entries. Here is the updated code for anyone looking to do the same. Thanks again Brucef!

Sub ZipLookUp()
Dim URL As String, xmlHTTP As Object, html As Object, htmlResponse As String
Dim SStr As String, EStr As String, EndS As Integer, StartS As Integer
Dim Zip4Digit As String


Dim number As String
Dim address As String
Dim city As String
Dim state As String
Dim zipcode As String
Dim abc As String
Dim cell As Range


For Each cell In Range("C2:C1500")
newHour = Hour(Now())
newMinute = Minute(Now())
NewSecond = Second(Now()) + 5
waitTime = TimeSerial(newHour, newMinute, NewSecond)
Application.Wait waitTime


number = Sheet1.Range("A" & cell.Row)
address = Sheet1.Range("B" & cell.Row)
city = Sheet1.Range("C" & cell.Row)
state = Sheet1.Range("D" & cell.Row)
zipcode = Sheet1.Range("E" & cell.Row)


URL = "https://tools.usps.com/go/ZipLookupResultsAction!input.action?resultMode=1&companyName=&address1="
URL = URL & number & "+" & address & "&address2=&city=" & city & "&state=" & state & "&urbanCode=&postalCode=&zip=" & zipcode
Set xmlHTTP = CreateObject("MSXML2.XMLHTTP")
xmlHTTP.Open "GET", URL, False
On Error GoTo NoConnect
xmlHTTP.send
On Error GoTo 0
Set html = CreateObject("htmlfile")
htmlResponse = xmlHTTP.responseText
If htmlResponse = Null Then
MsgBox ("Aborted - HTML response was null")
GoTo End_Prog
End If


SStr = "class=""zip4"">": EStr = "</span><br />" 'Searches for a string within 2 strings
StartS = InStr(1, htmlResponse, SStr, vbTextCompare) + Len(SStr)
EndS = InStr(StartS, htmlResponse, EStr, vbTextCompare)
Zip4Digit = Mid(htmlResponse, StartS, 4)


Sheet1.Range("F" & cell.Row).Value = Zip4Digit


GoTo End_Prog
NoConnect:
If Err = -2147467259 Or Err = -2146697211 Then MsgBox "Error - No Connection": GoTo End_Prog 'MsgBox Err & ": " & Error(Err)
End_Prog:
Next cell

End Sub

 

[brucef2112]

Well, I tried your code and your data.
I changed these two lines and the code and ran just fine, finding all of them. Even added my own address just for giggles.
SStr = "class=""zip4"">"
Zip4Digit = Mid(htmlResponse, StartS, 4)

 

[brucef2112]

You are more than welcome Neasley.
Here's a bonus back to you. I cleaned your code up a bit.
Removed orphan variables, Declared those that weren't,
took the Next statement out of error handler section and moved above where it should be).
User now has choice to continue or Quit if 'No Connection Found'.
Added the With ws so there's no need to reference 'Sheetx' Object for every action.
Changed the hardcoded 5 seconds wait, to a Random 10-20 seconds to keep from getting blocked by the Post Office for batch processing.
Also format the code so its easier to follow the With's...End with For Each...Next IF...End If
Got rid of your variable named 'cell' so it is not confused with Excel's Cell Object.
Added better error handling and messaging including letting the User know when the process is done.

Sub ZipLookUp() 
Dim sURL As String, xmlHTTP As Object, htmlResponse As String
Dim sStr As String, StartS As Integer
Dim Zip4Digit As String, Number As String, Address As String, City As String
Dim State As String, ZipCode As String
Dim x As Long, startRow As Long, EndRow As Long
Dim r As Range

Dim ws As Worksheet
Dim ErrAnsw As Long
Dim WaitTime As Variant, NewSec As Variant, NewMin As Variant, newHr As Variant


' ********************************************************************
' Token string to find in the returned html to get the zip4 number.
  sStr = "class=""zip4"">"
' ********************************************************************


Set ws = ActiveSheet
With ws
  ' ********************************************************************
    ' First cell with data below header.
    ' Can be any column that is sure to have data down the entire data set.
    ' Column B is good because all rows will have 'Address' data.
    Set r = .Range("B2")
  ' ********************************************************************
    startRow = r.Row
    ' Get the last row with data in the column.
    EndRow = .Cells(.Rows.Count, r.Column).End(xlUp).Row ' < allows a dynamic end row as data changes in sheet.


    For x = startRow To EndRow
        
        Debug.Print Now() ' Just for testing.
        
        newHr = Hour(Now())
        NewMin = Minute(Now())
        'newsecond = Second(Now()) + 5
        ' Five seconds is not very humban like.
        ' Lets do a random between 10 and 20 seconds the current seconds time so the server thinks we are a bit human like.
        ' Process with delay is a bit longer but getting blocked is even longer.
        Randomize
        NewSec = Second(Now()) + Int((20 - 10 + 1) * Rnd + 10)
        WaitTime = TimeSerial(newHr, NewMin, NewSec)
        
        Debug.Print WaitTime ' Just for testing.
        
        Application.Wait WaitTime
        
        Number = .Range("A" & x)
        Address = .Range("B" & x)
        City = .Range("C" & x)
        State = .Range("D" & x)
        ZipCode = .Range("E" & x)
        
        sURL = "https://tools.usps.com/go/ZipLookupResultsAction!input.action?resultMode=1&companyName=&address1="
        sURL = sURL & Number & "+" & Address & "&address2=&city=" & City & "&state=" & State & "&urbanCode=&postalCode=&zip=" & ZipCode
        
        Set xmlHTTP = CreateObject("MSXML2.XMLHTTP")
        xmlHTTP.Open "GET", sURL, False
        
        On Error GoTo NoConnect
        
        xmlHTTP.send
        On Error GoTo 0
        Set html = CreateObject("htmlfile")
        htmlResponse = xmlHTTP.responseText
        If htmlResponse = Null Then
            MsgBox "Aborted - HTML response was null", vbCritical
            Exit For
        End If
        
        StartS = InStr(1, htmlResponse, sStr, vbTextCompare) + Len(sStr)
        Zip4Digit = Mid(htmlResponse, StartS, 4)
        
        .Range("F" & x).Value = Zip4Digit
        
NextIteration:
    Next
End With


End_Prog:
    MsgBox "Done."
    Exit Sub


NoConnect:
    If Err = -2147467259 Or Err = -2146697211 Then
        ErrAnsw = MsgBox("No Connection to:" & vbCrLf & Left(sURL, 40) & "...." & vbCrLf _
                & "Do you want to continue processing the next address?", vbYesNo + vbInformation, "Error-No Connection")
        
        If ErrAnsw = vbYes Then GoTo NextIteration
        
    Else ' Tell user what the unspecified error is. Otherwise you'll **** them off with no feedback of the problem.
       MsgBox "Error Number: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Something is wrong."
    End If
    GoTo End_Prog
    
End Sub

And a friendly reminder, when posting your code to a message please use the CODE tags around your pasted code.
Next time you post a message, take notice of the # button to the right of the reply tool bar. To insert your code, Click the # , then paste your code inside the middle of it.
Or to find out more, Click here to see how to insert your code sample into a post without upsetting anyone, (especially Moderators)