Using split function in vba

adhbrown

New Member
Joined
May 18, 2010
Messages
10
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:

Code:
 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,
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

xld

Banned
Joined
Feb 8, 2003
Messages
5,378
Code:
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
 

Forum statistics

Threads
1,172,032
Messages
5,878,823
Members
433,373
Latest member
strichpunkt

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