Split Address with Space

Blessy Clara

Board Regular
Joined
Mar 28, 2010
Messages
201
Please help - How to split this address string

[TABLE="******* 387"]
<tbody>[TR]
[TD="class: xl64, ******* 387"]1 /650 Burwood Road HAWTHORN EAST VIC 3123

From Right Using Space

First space in one column = Zipcode (3123)
Next Space in another column = City (Vic)
Next Space in Another column = Hawthorn East[/TD]
[/TR]
</tbody>[/TABLE]

Samples
[TABLE="******* 387"]
<colgroup><col></colgroup><tbody>[TR]
[TD]1 /650 Burwood Road HAWTHORN EAST VIC 3123[/TD]
[/TR]
[TR]
[TD]1 10A Atherton Road OAKLEIGH VIC 3166[/TD]
[/TR]
[TR]
[TD]1 3A Takalvan Street BUNDABERG QLD 4670[/TD]
[/TR]
[TR]
[TD]1 48 George Street BEENLEIGH QLD 4207[/TD]
[/TR]
[TR]
[TD]1 Bangalow Road BALLINA NSW 2478[/TD]
[/TR]
[TR]
[TD]1 Beach Road AYR QLD 4807[/TD]
[/TR]
[TR]
[TD]1 Chale Ct BUNDALL QLD 4217[/TD]
[/TR]
[TR]
[TD]1 Cypress Place WALLERAWANG NSW 2845[/TD]
[/TR]
[TR]
[TD]1 David Street OLD BAR BEACH NSW 2430[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
I would solve this with an array, but couldn't get that to work.


Book1
ABCDEFG
383SamplesZIPTTownroadstreetctplace
3841 /650 Burwood Road HAWTHORN EAST VIC 31233123VICHAWTHORN EAST   
3851 10A Atherton Road OAKLEIGH VIC 31663166VICOAKLEIGH
3861 3A Takalvan Street BUNDABERG QLD 46704670QLDBUNDABERG
3871 48 George Street BEENLEIGH QLD 42074207QLDBEENLEIGH
3881 Bangalow Road BALLINA NSW 24782478NSWBALLINA
3891 Beach Road AYR QLD 48074807QLDAYR
3901 Chale Ct BUNDALL QLD 42174217QLDBUNDALL
3911 Cypress Place WALLERAWANG NSW 28452845NSWWALLERAWANG
3921 David Street OLD BAR BEACH NSW 24302430NSWOLD BAR BEACH
Blad1
Cell Formulas
RangeFormula
B384=RIGHT($A384,4)
C384=LEFT(RIGHT($A384,8),3)
D384=IFERROR(MID($A384,SEARCH(" ",$A384,SEARCH(D$383,$A384,1))+1,LEN($A384)-SEARCH(" ",$A384,SEARCH(D$383,$A384,1))-9),"")
E384=IFERROR(MID($A384,SEARCH(" ",$A384,SEARCH(E$383,$A384,1))+1,LEN($A384)-SEARCH(" ",$A384,SEARCH(E$383,$A384,1))-9),"")
F384=IFERROR(MID($A384,SEARCH(" ",$A384,SEARCH(F$383,$A384,1))+1,LEN($A384)-SEARCH(" ",$A384,SEARCH(F$383,$A384,1))-9),"")
G384=IFERROR(MID($A384,SEARCH(" ",$A384,SEARCH(G$383,$A384,1))+1,LEN($A384)-SEARCH(" ",$A384,SEARCH(G$383,$A384,1))-9),"")
 
Upvote 0
Hi

Try this:
change code as per your requirement

Code:
Private Sub Parse()
  
    Dim sText As Variant, m As Integer
  
    Dim strInput As String
    Dim Myrange As Range, c As Range, sRange As Range
    m = 0
    Dim iRow As Integer: iRow = 1
    Set Myrange = ActiveSheet.Range("A:A")

  For Each c In Myrange
           
           strInput = c.Value
                 
            If strInput = "" Then Exit Sub
            
                   sText = Split(strInput, " ")
                    
                  For m = 0 To UBound(sText)
                     
                       If m = UBound(sText) - 3 Then Cells(iRow, 5) = sText(m) & " " & sText(m + 1): m = m + 1
                       If m = UBound(sText) - 1 Then Cells(iRow, 4) = sText(m)
                       If m = UBound(sText) Then Cells(iRow, 3) = sText(m)
                                
                         
                  Next m
            
           
        iRow = iRow + 1
 Next c
End Sub
 
Upvote 0
My Output like this:

DataPincode
CityState ??
1 /650 Burwood Road HAWTHORN EAST VIC 3123VICHAWTHORN EAST
1 10A Atherton Road OAKLEIGH VIC 3166VICRoad OAKLEIGH
1 3A Takalvan Street BUNDABERG QLD 4670QLDStreet BUNDABERG
1 48 George Street BEENLEIGH QLD 4207QLDStreet BEENLEIGH
1 Bangalow Road BALLINA NSW 2478NSWRoad BALLINA
1 Beach Road AYR QLD 4807QLDRoad AYR
1 Chale Ct BUNDALL QLD 4217QLDCt BUNDALL
1 Cypress Place WALLERAWANG NSW 2845NSWPlace WALLERAWANG
1 David Street OLD BAR BEACH NSW 2430NSWBAR BEACH

<tbody>
[TD="align: right"]3123[/TD]

[TD="align: right"]3166[/TD]

[TD="align: right"]4670[/TD]

[TD="align: right"]4207[/TD]

[TD="align: right"]2478[/TD]

[TD="align: right"]4807[/TD]

[TD="align: right"]4217[/TD]

[TD="align: right"]2845[/TD]

[TD="align: right"]2430[/TD]

</tbody>
 
Last edited:
Upvote 0
Thank you for your effort and time. Could you please help me split the address as this (Uppercase to distinguish address and city may be)
[TABLE="class: cms_table"]
<tbody>[TR]
[TD][TABLE="******* 545"]
<colgroup><col><col><col span="2"></colgroup><tbody>[TR]
[TD]1 /650 Burwood Road [/TD]
[TD]HAWTHORN EAST[/TD]
[TD]VIC[/TD]
[TD="align: right"]3123[/TD]
[/TR]
[TR]
[TD]1 10A Atherton Road[/TD]
[TD]OAKLEIGH[/TD]
[TD]VIC[/TD]
[TD="align: right"]3166[/TD]
[/TR]
[TR]
[TD]1 3A Takalvan Street [/TD]
[TD]BUNDABERG[/TD]
[TD]QLD[/TD]
[TD="align: right"]4670[/TD]
[/TR]
[TR]
[TD]1 48 George Street [/TD]
[TD]BEENLEIGH[/TD]
[TD]QLD[/TD]
[TD="align: right"]4207[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:
Upvote 0
Hi
check it as per your requirement

Code:
 Private Sub SpliteAddress()
    Dim sText As Variant, m As Integer
    Dim bExist As Boolean: bExist = False
    Dim strInput As String, p As Integer
    Dim Myrange As Range, c As Range
    m = 0
    Dim iRow As Integer: iRow = 1
    
    Set Myrange = ActiveSheet.Range("A:A")
   
    
  For Each c In Myrange
       
       With CreateObject("VBScript.RegExp")
            strInput = c.Value
                 
             .Pattern = "[^a-z]"
                 
            If strInput = "" Then Exit Sub
            
                   sText = Split(strInput, " ")
                    
                  For m = 1 To UBound(sText)
                     
                       If m = UBound(sText) - 3 Then
                            
                           ' checking is there any upper case alphabet
                           
                                 For p = 1 To Len(sText(m))
                                      If Not .test(Mid(sText(m), p, 1)) Then
                                          GoTo Out
                                      End If
                                 Next p
                                    
                                   Cells(iRow, 5) = sText(m) & " " & sText(m + 1)
                                        bExist = True
                             ' m = m + 1
                              GoTo Out
                           'End If
                          End If
                          
                      If m = UBound(sText) - 2 And bExist = False Then
                            
                          ' checking is there any upper case alphabet
                            For p = 1 To Len(sText(m))
                                      If Not .test(Mid(sText(m), p, 1)) Then
                                            GoTo Out
                                      End If
                                 Next p
                                Cells(iRow, 5) = sText(m)
                        End If
                        
                       If m = UBound(sText) - 1 Then Cells(iRow, 4) = sText(m)
                       If m = UBound(sText) Then Cells(iRow, 3) = sText(m)
                                
Out:
                  Next m
         iRow = iRow + 1
      End With
      bExist = False
 Next c
End Sub
 
Upvote 0
Could you please help me split the address as this (Uppercase to distinguish address and city may be)
[TABLE="class: cms_table"]
<tbody>[TR]
[TD][TABLE="******* 545"]
<colgroup><col><col><col span="2"></colgroup><tbody>[TR]
[TD]1 /650 Burwood Road [/TD]
[TD]HAWTHORN EAST[/TD]
[TD]VIC[/TD]
[TD="align: right"]3123[/TD]
[/TR]
[TR]
[TD]1 10A Atherton Road[/TD]
[TD]OAKLEIGH[/TD]
[TD]VIC[/TD]
[TD="align: right"]3166[/TD]
[/TR]
[TR]
[TD]1 3A Takalvan Street [/TD]
[TD]BUNDABERG[/TD]
[TD]QLD[/TD]
[TD="align: right"]4670[/TD]
[/TR]
[TR]
[TD]1 48 George Street [/TD]
[TD]BEENLEIGH[/TD]
[TD]QLD[/TD]
[TD="align: right"]4207[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

1] Data in Column A

2] B1, formula copy down :

=LEFT(A1,MATCH(2,INDEX(1/(CODE(MID(A1,ROW($1:$20),1))>90),0))+1)

3] C1, formula copy down :

=MID(A1,MATCH(2,INDEX(1/(CODE(MID(A1,ROW($1:$22),1))>90),0))+2,LEN(A1)-MATCH(2,INDEX(1/(CODE(MID(A1,ROW($1:$22),1))>90),0))-10)

4] D1, formula copy down :

=LEFT(RIGHT(A1,8),3)

5] E1, formula copy down :

=RIGHT(A1,4)

Regards
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,906
Members
452,366
Latest member
TePunaBloke

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
Back
Top