Split Address with Space

[Blessy Clara]

Please help - How to split this address string

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

<tbody>
</tbody>

Samples

1 /650 Burwood Road HAWTHORN EAST VIC 3123

1 10A Atherton Road OAKLEIGH VIC 3166

1 3A Takalvan Street BUNDABERG QLD 4670

1 48 George Street BEENLEIGH QLD 4207

1 Bangalow Road BALLINA NSW 2478

1 Beach Road AYR QLD 4807

1 Chale Ct BUNDALL QLD 4217

1 Cypress Place WALLERAWANG NSW 2845

1 David Street OLD BAR BEACH NSW 2430

<colgroup><col></colgroup><tbody>
</tbody>

 

[Oeldere]

I would solve this with an array, but couldn't get that to work.

Book1
	A	B	C	D	E	F	G
383	Samples	ZIPT	Town	road	street	ct	place
384	1 /650 Burwood Road HAWTHORN EAST VIC 3123	3123	VIC	HAWTHORN EAST
385	1 10A Atherton Road OAKLEIGH VIC 3166	3166	VIC	OAKLEIGH
386	1 3A Takalvan Street BUNDABERG QLD 4670	4670	QLD		BUNDABERG
387	1 48 George Street BEENLEIGH QLD 4207	4207	QLD		BEENLEIGH
388	1 Bangalow Road BALLINA NSW 2478	2478	NSW	BALLINA
389	1 Beach Road AYR QLD 4807	4807	QLD	AYR
390	1 Chale Ct BUNDALL QLD 4217	4217	QLD			BUNDALL
391	1 Cypress Place WALLERAWANG NSW 2845	2845	NSW				WALLERAWANG
392	1 David Street OLD BAR BEACH NSW 2430	2430	NSW		OLD BAR BEACH
Blad1

Cell Formulas
Range	Formula
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),"")

 

[mohan.r1980]

Hi

Try this:
change code as per your requirement

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

 

[mohan.r1980]

My Output like this:

Data		Pincode	City	State ??
1 /650 Burwood Road HAWTHORN EAST VIC 3123		3123	VIC	HAWTHORN EAST
1 10A Atherton Road OAKLEIGH VIC 3166		3166	VIC	Road OAKLEIGH
1 3A Takalvan Street BUNDABERG QLD 4670		4670	QLD	Street BUNDABERG
1 48 George Street BEENLEIGH QLD 4207		4207	QLD	Street BEENLEIGH
1 Bangalow Road BALLINA NSW 2478		2478	NSW	Road BALLINA
1 Beach Road AYR QLD 4807		4807	QLD	Road AYR
1 Chale Ct BUNDALL QLD 4217		4217	QLD	Ct BUNDALL
1 Cypress Place WALLERAWANG NSW 2845		2845	NSW	Place WALLERAWANG
1 David Street OLD BAR BEACH NSW 2430		2430	NSW	BAR BEACH

<tbody>
</tbody>

 

[Blessy Clara]

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)

1 /650 Burwood Road HAWTHORN EAST VIC 3123 1 10A Atherton Road OAKLEIGH VIC 3166 1 3A Takalvan Street BUNDABERG QLD 4670 1 48 George Street BEENLEIGH QLD 4207 <colgroup><col><col><col span="2"></colgroup><tbody> </tbody>

<tbody>
</tbody>

 

[Oeldere]

what about the solution in #2?

 

[mohan.r1980]

Hi
check it as per your requirement

 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

 

[bosco_yip]

Could you please help me split the address as this (Uppercase to distinguish address and city may be)

1 /650 Burwood Road HAWTHORN EAST VIC 3123 1 10A Atherton Road OAKLEIGH VIC 3166 1 3A Takalvan Street BUNDABERG QLD 4670 1 48 George Street BEENLEIGH QLD 4207 <colgroup><col><col><col span="2"></colgroup><tbody> </tbody>

<tbody>
</tbody>

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

 

[Blessy Clara]

@ mohanr 1980 Hi, yes it works cool, thanks alot for your effort

 

[Blessy Clara]

thank you for your effort.