Mailing address block: sorting 1 row to columns

[rick14220]

Mailing address block: sorting data in 1 row to columns

I have a database of thousands of names that are in 1 row, not separated into columns. They vary somewhat in the amount of information given (normal for mailing lists) ie:

Company Name
Contact Name
Address1
Address2
City, St, Zip

VS

Company Name
Address1
City, St, Zip

I need to sort them into columns for the post office like this:

Company Name Contact Name Address1 Address2 City St Zip

People have shown me how to transpose but that leaves me with a very looooooong row of data instead of a looooong column of data.

Can anyone help? Please?

Riock

 

[Claus Busch]

Hi Rick,

Am Sun, 19 May 2013 14:18:34 -0700 (PDT) schrieb (e-mail address removed):

Company Name
Contact Name
Address1
Address2
City, St, Zip

VS

Company Name
Address1
City, St, Zip

try it with a macro:

Sub SortToColumns()
Dim myCt As Integer
Dim rngC As Range
Dim LRow As Long
Dim i As Integer
Dim myStr As String

LRow = Cells(Rows.Count, 1).End(xlUp).Row
For Each rngC In Range("A1:A" & LRow)
myCt = Len(rngC) - Len(Replace(rngC, Chr(10), ""))
myStr = ""
Select Case myCt
Case 4
rngC.Offset(0, 1) = Left(rngC, InStr(rngC, Chr(10)) - 1)
For i = 1 To 3
myStr = WorksheetFunction.Substitute(rngC, Chr(10), "#", i)
rngC.Offset(0, i + 1) = Mid(myStr, InStr(myStr, "#") + 1, _
InStr(InStr(myStr, "#"), myStr, Chr(10)) - InStr(myStr, "#"))
Next
myStr = WorksheetFunction.Substitute(rngC, Chr(10), "#", 4)
rngC.Offset(0, 5) = Trim(Mid(myStr, InStr(myStr, "#") + 1, 99))
Case 2
rngC.Offset(0, 1) = Left(rngC, InStr(rngC, Chr(10)) - 1)
myStr = WorksheetFunction.Substitute(rngC, Chr(10), "#", 1)
rngC.Offset(0, 3) = Mid(myStr, InStr(myStr, "#") + 1, _
InStr(InStr(myStr, "#") + 1, myStr, Chr(10)) - InStr(myStr, "#"))
myStr = WorksheetFunction.Substitute(rngC, Chr(10), "#", 2)
rngC.Offset(0, 5) = Trim(Mid(myStr, InStr(myStr, "#") + 1, 99))
End Select
Next
Columns("F").TextToColumns Destination:=Range("F1"), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
Comma:=True, FieldInfo:= Array(Array(1, 1), Array(2, 1), _
Array(3, 1)), TrailingMinusNumbers:=True
Columns("B:H").AutoFit
End Sub


Regards
Claus Busch