Break of an address in a cell

[drop05]

I’m VBA. Is this possible, If a cell has an address, state, city, and zip code and state in one cell. Is it possible to break that up into separate cells?
So the address is in
cell A1 = 123 Address st, Dallas, Tx, 12345

and I want to copy the address and break it into different cells and paste into sheet2

so sheet 2
A1 is the address: 123 address st
A2 is city: Dallas
A3 is state: Tx
A4 is zip: 12345

 

[drop05]

My last edited post splits it without a loop. The split is done based on a comma, then the array is spread across the four columns.

Sub SplitAddr()
' split address in A1
Dim addr() As String
addr = Split(Range("A1"), ",")
Range("B1:E1") = addr
End Sub

All in 1 line:

Sub SplitAddr()
Range("B1:E1") = Split(Range("A1"), ",")
End Sub

is there a way to do it vertical instead of horizontal?
also maybe say it is a US address and the pasting locations is like so
b1 = address
b2 = city
b3 =province or state
b4 = state abbreviation
b5 = country code
b6 = zip code
b7 = fore postal code

if the split was: address, city, state, zip
there a way to get it to their landing spots?

 

[Radoslaw Poprawski]

just use =TRANSPOZE function on ur data set.

 

[kweaver]

is there a way to do it vertical instead of horizontal?
also maybe say it is a US address and the pasting locations is like so
b1 = address
b2 = city
b3 =province or state
b4 = state abbreviation
b5 = country code
b6 = zip code
b7 = fore postal code

if the split was: address, city, state, zip
there a way to get it to their landing spots?

This suggestion doesn't take into account multiple addresses in the A column.

Sub SplitAddr()
' split address in A1
Dim addr() As String, i As Long
addr = Split(Range("A1"), ",")
 For i = 0 To UBound(addr)
  ' Cells(1, i + 2) = addr(i) ' original horizontal result starting in column B
  Cells(i + 1, "B") = addr(i) ' vertical using column B
 Next i
End Sub

This one will handle multiple addresses in the A column and begin inserting them from column B on...

Sub SplitAddr2()
' split address in A
Dim addr() As String, i As Long, j As Long, lr As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
 For j = 1 To lr
addr = Split(Range("A" & j), ",")
 For i = 0 To UBound(addr)
  ' Cells(1, i + 2) = addr(i) ' original horizontal result starting in column B
  Cells(i + 1, j + 1) = addr(i) ' vertical using column B
 Next i
Next j
End Sub

Book1
	A	B	C	D
1	123 Address st, Dallas, Tx, 12345	123 Address st	555 North Ave.	100 South Street
2	555 North Ave., Somewhere, CA, 92100	Dallas	Somewhere	SomeCity
3	100 South Street, SomeCity, XX, 11111, USA	Tx	CA	XX
4		12345	92100	11111
5				USA
Address

 

[drop05]

This suggestion doesn't take into account multiple addresses in the A column.

Sub SplitAddr()
' split address in A1
Dim addr() As String, i As Long
addr = Split(Range("A1"), ",")
 For i = 0 To UBound(addr)
  ' Cells(1, i + 2) = addr(i) ' original horizontal result starting in column B
  Cells(i + 1, "B") = addr(i) ' vertical using column B
 Next i
End Sub

This one will handle multiple addresses in the A column and begin inserting them from column B on...

Sub SplitAddr2()
' split address in A
Dim addr() As String, i As Long, j As Long, lr As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
 For j = 1 To lr
addr = Split(Range("A" & j), ",")
 For i = 0 To UBound(addr)
  ' Cells(1, i + 2) = addr(i) ' original horizontal result starting in column B
  Cells(i + 1, j + 1) = addr(i) ' vertical using column B
 Next i
Next j
End Sub

Book1
	A	B	C	D
1	123 Address st, Dallas, Tx, 12345	123 Address st	555 North Ave.	100 South Street
2	555 North Ave., Somewhere, CA, 92100	Dallas	Somewhere	SomeCity
3	100 South Street, SomeCity, XX, 11111, USA	Tx	CA	XX
4		12345	92100	11111
5				USA
Address

Copy that and understood. It is not so much multiple address in one cell but i have two workbooks one that has information put into the other where it will be migrated over to. I can show how it looks below
The way the image k ref is, it will contain an address and the split will go in how x ref image shows it. I listed the cells from the other image for reference. Im using this code in other areas but ran into the issue of this containing address from my source and then my paste file having it broken up
code:

Sub address()
num_ent = Worksheets("path").Range("D10")
For i = 0 To num_ent
For k = 0 To 1
With Worksheets("Sheet1")
lastcol = .Cells(k + 52 + i * 351, .Columns.Count).End(xlToLeft).Column
End With
If lastcol > 7 Then
With Worksheets("Sheet1")
inarr = .Range(.Cells(k + 52 + i * 351, 7), .Cells(k + 52 + i * 351, lastcol))
End With
If inarr(1, 1) <> "" Then
With Worksheets("Sheet2")
For j = 1 To UBound(inarr, 2)
jj = j - 1
.Range(.Cells(k + 163 + jj * 11, 6 + i), .Cells(k + 163 + jj * 11, 6 + i)) = inarr(1, j)
Next j
End With
End If
End If
Next k
Next i
End Sub

This code takes info from sheet 1 and pastes into sheet2 in the workbook. it checks for instance cell G52 and everything to the right of it and copies those values and pastes them into sheet2 starting at F163 then goes down 11 rows and pastes there then another 11 and so on.
So in this case I am trying to do the same but with a split in the address if possible. Then with num_ent sheet1 jumps 351 cells and it looks exactly the same just at 404 and then does the same but now those values paste into column G and does the same, then goes to H and so on depending on what num_ent is

is there anyway to implement the split on how it is broken up in sheet2 using this code.

So say address in sheet

 

[DanteAmor]

I had posted the answer in the other thread, but it was closed by the moderator, because the thread is duplicated with this thread.
I put the solution here, try and comment:

Sub address()
  Dim num_ent As Long, lastcol As Long, nRow As Long
  Dim i As Long, j As Long, jj As Long, k As Long
  Dim inarr As Variant
  
  num_ent = Worksheets("path").Range("D10")
  For i = 0 To num_ent
    For k = 0 To 1
      With Worksheets("Sheet1")
        lastcol = .Cells(k + 52 + i * 351, .Columns.Count).End(xlToLeft).Column
      End With
      If lastcol > 7 Then
        With Worksheets("Sheet1")
          inarr = .Range(.Cells(k + 52 + i * 351, 7), .Cells(k + 52 + i * 351, lastcol))
        End With
        If inarr(1, 1) <> "" Then
          With Worksheets("Sheet2")
            For j = 1 To UBound(inarr, 2)
              jj = j - 1
              nRow = k + 163 + jj * 11
              On Error Resume Next
              .Cells(nRow + 0, 6 + i) = Split(inarr(1, j), ",")(0)
              .Cells(nRow + 1, 6 + i) = Split(inarr(1, j), ",")(1)
              .Cells(nRow + 2, 6 + i) = Split(inarr(1, j), ",")(2)
              .Cells(nRow + 5, 6 + i) = Split(inarr(1, j), ",")(3)
              On Error GoTo 0
              '.Range(.Cells(k + 163 + jj * 11, 6 + i), .Cells(k + 163 + jj * 11, 6 + i)) = inarr(1, j)
            Next j
          End With
        End If
      End If
    Next k
  Next i
End Sub

 

[skf786]

Here's another VBA way without a loop:

Sub SplitAddr()
' split address in A1
Dim addr() As String
addr = Split(Range("A1"), ",")
Range("B1:E1") = addr
End Sub

can you please add a loop so that the macro splits address cells for all data available in the sheet. Also, is it possible that the macro names the headers as Add1, Add2, Add3, Add4.

thank you.

 

[skf786]

My last edited post splits it without a loop. The split is done based on a comma, then the array is spread across the four columns.

Sub SplitAddr()
' split address in A1
Dim addr() As String
addr = Split(Range("A1"), ",")
Range("B1:E1") = addr
End Sub

All in 1 line:

Sub SplitAddr()
Range("B1:E1") = Split(Range("A1"), ",")
End Sub

hello, i need to use the same code but with a loop to cover full data in the sheet named "Copy" Also, is it possible for macro to put headings on the split cells i.e. Add1, Add2, Add3 etc.

thank you.

 

[Peter_SSs]

macro splits address cells

Duplicate to: Split full name to first and middle and last name with single formula

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, I have closed this thread so please continue in the linked thread.