Help using Transpose

[vinhdang]

I need help with the transpose function. Currently I have 2000 columns
with data of people's names. For example

Jane Doe
Partner
J&J LLC
123 Four Street, NY, NY 12345
(123)456-789
(e-mail address removed)

Doe, John
Lawyer
J&J LLC
123 Four Street, NY, NY 12345
(123)456-789
(e-mail address removed)

I wish to transpose the data from a column to row with a delimiter
using that email address (because not all of the data has 6 rows of
data)

Is this possible without VisualBasic? Such as a function that will
notice the "@" symbol and transpose the next group of data into a new
row.

The output should be like this

Row One:
Jane Doe | Partner | J&J LLC | 123 Four Street, NY, NY 12345 |
(123)456-789 | (e-mail address removed)
Row Two:
Doe, John | Lawyer | | J&J LLC | 123 Four Street, NY, NY 12345 |
(123)456-789 | (e-mail address removed)

and so forth.

If you have any suggestions or websites I can check out, you have my
gratitude!

 

[Dave Peterson]

I don't think you'll be able to do this kind of thing with formulas--there's
just too much variation.

But a little macro may be able to do most/some of it. It surely won't get
everything perfect, but it would make the manual effort that you have to do a
bit easier.

It looks like you could put the data that looks like an address (last 5
characters of the string numbers) in a dedicated column.

If the code can clean up the phone number field (drop (, ), spacebar, -), it
could put that in its own column.

If the code sees the @, it can use that for the grouping as well as putting that
in its own column.

If there are duplicate "indicators", it'll be your job to make a note and fix
them later.

Anyway, this is the code that will make your job a little easier--but it won't
do it perfect!

Option Explicit
Sub testme()

Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim rCtr As Long
Dim oRow As Long
Dim oCol As Long
Dim iRow As Long
Dim iStr As String
Dim TestStr As String
Dim PrevCellWasAnEmailAddress As Boolean

Set CurWks = ActiveSheet
Set NewWks = Worksheets.Add

oRow = 0
PrevCellWasAnEmailAddress = True
With CurWks
For iRow = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If PrevCellWasAnEmailAddress = True Then
oRow = oRow + 1
rCtr = 0
'turn it off
PrevCellWasAnEmailAddress = False
End If

iStr = .Cells(iRow, "A").Value
If Trim(iStr) = "" Then
'do nothing
Else
If InStr(1, iStr, "@", vbTextCompare) > 0 Then
'on an email line
oCol = 10
PrevCellWasAnEmailAddress = True
Else
TestStr = Application.Substitute(iStr, " ", "")
TestStr = Application.Substitute(TestStr, "(", "")
TestStr = Application.Substitute(TestStr, ")", "")
TestStr = Application.Substitute(TestStr, "-", "")
If IsNumeric(TestStr) Then
'maybe a phone number
oCol = 9
Else
If IsNumeric(Right(Trim(iStr), 5)) Then
'maybe a zip code line
oCol = 8
Else
rCtr = rCtr + 1
'just put it in the next column over
oCol = rCtr
End If
End If
End If
If IsEmpty(NewWks.Cells(oRow, oCol).Value) Then
NewWks.Cells(oRow, oCol).Value = iStr
Else
MsgBox "Attempting to put duplicate data" & vbLf & _
"in: " & .Cells(oRow, oCol).Address(0, 0) & vbLf & _
"From: " & .Cells(iRow, "A").Address & vbLf & _
"Please make a note and check it later!"
End If

End If
Next iRow
End With

End Sub

ps. If there are columns that aren't used, just delete them from the output.
If you want to rearrange the columns, just drag them where you want them after
the macro finishes. (Somethings are easier to just do manually!)

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm