Excel - converting address labels to columns

[elgeejay]

I initially posted this in the Excel forum and got several suggestions. However, a programmer who responded provided one possible solution (below) but also suggested that I “Post it in the Office VBA forum. What I [he] posted here could be done in VBA but would require a bit more detail.”

I thot perhaps this was something that others regularly encountered and that there might be a more or less "standard" solution. Clearly that is not the case.

The person who created the list typed them one-by-one into a Word label template from a handwritten list. I sure don't want to have to cut/paste everything for 1,000 records..

ORIGINAL POST:
Here are examples of 3 and 4 line addresses in a Word file of labels that I have imported into Excel. Now, I need to convert the 3 and 4 line addresses to columns in Excel; e.g., col headings like:

Salutation/Company/Street/City/State/Zip (some with 5 digit Zip, some with Zip+4).

There is one blank row between each address.

Jane, Kathy, & Gladys
Burke Blinds
4924 Lyngate Ct.
Burke, VA 22015

Mr. & Mrs. Harley Dorffman
3388 Chesma Drive
Woodbyne, VA 22192-4333

Can anyone provide something that can do this conversion? Thanks!

A PROGRAMMER’S RESPONSE (with suggestion that I also post in Office VBA forum)

How long is the list? [about 1,000 addresses] It seems that it would be easier to get the formatting right in the Word document first. As a variation on the Find/Replace:

1) Go to edit -> Replace
2) In the “Find What:” box type in a comma followed by a space.
3) Put your cursor in the “Replace With” box and press the “special” button.
4) Select “Manual Line Break”.

Cycle through all the commas and replace the commas with line breaks so that you get this.

Jane, Kathy, & Gladys
Burke Blinds
4924 Lyngate Ct.
Burke
VA
22015

Mr. & Mrs. Harley Dorffman
3388 Chesma Drive
Woodbyne
VA
22192-4333

Go through all the addresses and add a blank line so that they all have the same number of rows:

Jane, Kathy, & Gladys
Burke Blinds
4924 Lyngate Ct.
Burke
VA
22015

Mr. & Mrs. Harley Dorffman

3388 Chesma Drive
Woodbyne
VA
22192-4333

Copy and paste all the addresses into Excel starting a A2. Put your lables, Salutation/Company/Street/City/State/Zip, in cells B1 to G1. Select B2 to G2 and type in the formula:

=Transpose(A2:A7)

DO NOT HIT ENTER, press ctrl + Shift + enter to create an array formula. The equation should look like this:

{=Transpose(A2:A7)}

Select cells B2 to G2 and copy. Paste the formula in the same row that the 'Salutation' is in for each record.

Last, copy all the cells in columns B threw G and paste special 'Values' into a different sheet. To eliminate all the spaces do a sort (Data --> Sort).

 

[CautionMP]

elgeejay,
Here's a similar solution from the forum where you originally posted the question.
Microsoft: Office Transpose Column to Rows

Hope this helps,
CMP

[small]For the best results do what I'm thinking, not what I'm saying.[/small]
(GMT-07:00) Mountain Time (US & Canada)

 

[elgeejay]

Thanks, CautionMP.

I copied the code into my Excel VBA editor and ran it and... it almost works! It's very fast and very close to working.

The problem is probably that my original data is not all that clean, but what is happening is that the names are coming out on the wrong row; i.e., the address parsed correctly, but the name associated with a given addr is wrong. Usually it's only off by 1 row, so I could just move everything down (or up) one row. Unfortunately, some just don't cooperate.

Maybe I can figure out how to clean up my data and try again.

If you have any other suggestions, I would welcome them. Otherwise, thanks again for responding so quickly.

Regards,
elgeejay

 

[WinblowsME]

Sub Address_Labels()
   Dim i As Long, j As Integer, start_col As Integer, last_row As Long
   Dim city As String, state As String, zip As String
   
   last_row = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
   j = 1
   
   start_col = 4
   
   For i = 1 To last_row
      If Trim(Cells(i, 1)) <> "" Then
         If Trim(Cells(i + 3, 1)) = "" Then
            Cells(j, start_col) = Cells(i, 1)
            Cells(j, start_col + 2) = Cells(i + 1, 1)
            Call Get_City_State_Zip(Cells(i + 2, 1), city, state, zip)
            Cells(j, start_col + 3) = city
            Cells(j, start_col + 4) = state
            Cells(j, start_col + 5) = zip
            i = i + 3
         Else
            Cells(j, start_col) = Cells(i, 1)
            Cells(j, start_col + 1) = Cells(i + 1, 1)
            Cells(j, start_col + 2) = Cells(i + 2, 1)
            Call Get_City_State_Zip(Cells(i + 3, 1), city, state, zip)
            Cells(j, start_col + 3) = city
            Cells(j, start_col + 4) = state
            Cells(j, start_col + 5) = zip
            i = i + 3
         End If
         
         j = j + 1
      End If
   Next i
End Sub

Private Sub Get_City_State_Zip(aline As String, ByRef city As String, ByRef state As String, ByRef zip As String)
   Dim arr() As String, arr2() As String
   
   aline = Remove_Extra_Spaces(aline)
   arr = Split(aline, ",")
   city = arr(0)
   arr2 = Split(Trim(arr(1)), " ")
   state = arr2(0)
   zip = arr2(1)
End Sub

Private Function Remove_Extra_Spaces(aline As String) As String
   Dim regex As Object

   Set regex = CreateObject("VBScript.RegExp")
   regex.Global = True
   regex.pattern = " +"
   Remove_Extra_Spaces = regex.Replace(Trim(aline), " ")
End Function