Using split function in vba

[adhbrown]

Hello,

I have an address string that I need to split up into three cells using vba with the split function. The problem that I'm having is that I can't seem to formulate the functions in which they can handle different forms of the address.

For example,

New York, NY 23658 should return New York in one cell, NY in the next, and 23658 in the next.

New York, NY should return New York in one cell, NY in the next, and nothing in the next because there isn't a zip code.

The code I have for the first example is:

 Dim str1 As String
    Dim CityStateZip As String
    Dim i As Integer
    Dim j As Integer
    Dim m As Integer
    Dim n As Integer
    Dim url As String
    Dim KillFile As String
    
    
   
    m = ActiveCell.Row
    n = ActiveCell.Column
    
    
    
    For i = m To m + UBound(Selection.Value, 1) - 1
    
        str1 = ""
        CityStateZip = ""
        For j = n To n + UBound(Selection.Value, 2) - 1
            str1 = str1 & " " & Cells(i, j)
        Next j
    
    
GetGoogle:
        str1 = Trim(str1)
    
 
        Sheet2.Range("A:A").Clear
    

        url = "URL;http://maps.google.com/maps?hl=en&q=" & str1
        With Worksheets("Sheet2").QueryTables.Add(Connection:=url, Destination:=Worksheets("Sheet2").Range("A1"))
          .Name = "Address Verification"
          .RowNumbers = False
          .FillAdjacentFormulas = False
          .PreserveFormatting = True
          .RefreshOnFileOpen = False
          .BackgroundQuery = False
          .RefreshStyle = xlOverwriteCells
          .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 Resume Next
        
      
        
        If Sheet2.Range("A:A").Find("A.", Cells(1, 1), xlValues, xlPart, xlByRows, xlNext, True, False, False) Is Nothing Then
       
            str1 = Sheet2.Range("A:A").Find("Did you mean", Cells(1, 1), xlValues, xlPart, xlByRows, xlNext, True, False, False).Offset(1, 0)
            GoTo GetGoogle
        Else
  
            Sheet1.Cells(i, n + UBound(Selection.Value, 2)) = Sheet2.Range("A:A").Find("A.", Cells(1, 1), xlValues, xlPart, xlByRows, xlNext, True, False, False).Offset(1, 0)
            
            CityStateZip = Sheet2.Range("A:A").Find("A.", Cells(1, 1), xlValues, xlPart, xlByRows, xlNext, True, False, False).Offset(2, 0)
            
                 
             Sheet1.Cells(i, n + UBound(Selection.Value, 2) + 1) = Trim(Left(CityStateZip,Find(" ",CityStateZip) Len(CityStateZip) - 10))
            Sheet1.Cells(i, n + UBound(Selection.Value, 2) + 2) = Trim(Mid(CityStateZip, Len(CityStateZip) - 8, 4))
            Sheet1.Cells(i, n + UBound(Selection.Value, 2) + 3) = Trim(Right(CityStateZip, 5))
      

      
        End If
   
            If Err.Number = 91 Then
            Sheet1.Cells(i, n).Interior.ColorIndex = 3
            End If
    
    
        KillFile = "C:\Documents and Settings\" & Environ("username") & "\Local Settings\Temporary Internet Files\*.*"
            
        If Len(Dir$(KillFile)) > 0 Then
      
            Kill "C:\Documents and Settings\" & Environ("username") & "\Local Settings\Temporary Internet Files\*.*"
        End If
            
      
        
       
 
      Next i

End Sub

This code works but I think it would be better if I used the split function.

Thanks in advance,

 

[xld]

Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim ary1 As Variant
Dim ary2 As Variant

    With ActiveSheet
        
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 1 To LastRow 'LastRow to 1 Step -1
        
            ary1 = Split(.Cells(i, "A").Value2, ",")
            If UBound(ary1) > LBound(ary1) Then
            
                ary2 = Split(Trim(ary1(1)), " ")
            End If
            .Cells(i, "A").Value2 = ary1(0)
            .Cells(i, "B").Resize(, UBound(ary2) - LBound(ary2) + 1) = ary2
        Next i
    End With
    
End Sub