Macro to transpose data

Champ007,

(1) Will every entry have at least a Name, Company, Email Address, Date and Title?
(2) Are there any other entries that might appear (including blank rows)?
(3) Will every entry have the same sequence in column A, i.e. Name, Company, Division (optional), Email Address, Phone No (optional) and Date?
(4) What version of Excel do you (or the user(s)) have?

Thanks,
Brian.

(1) Yes
(2) No additional entries. But there may be blank rows
(3) Yes, the sequence is the same.  But as you noted, there are optional fields. These fields should be left blank in the "Formatted Data" worksheet.
(4) Excel 2007

Thanks

Champ007,

Assuming that there are no surprises in your answers, this can easily be done with formulas. Have you a strong preference for a macro solution?

Thanks,
Brian.

Champ007,

Oops, overlapping posts. The blank rows might be a problem. Let me have a think!

Regards,
Brian.

The problem, as I see it, is not the Transpose Macro... it is easy to create if RAW sheet has ALL fields repeated, even if there is a blank space where there is Not Division or Phone Number information...

The lack of some "fields" in RAW Sheet could end having wrong entries when Transposing the data ... you could use a Search function to Paste values in Email Field if there is an @ in the names, but Not all @ means email address...

@Champ: It is possible for you to show ALL People with the same Format in RAW data ?... meaning as format, the same rows with data for each Person ?...
I'm doing this question as a formality, due that I think this is probably what you are triying to reach because you mention you have more than 5.000 rows of data...

Regards,
R.

redmondb,

I actually do prefer macros. There do not seem to be very many blank rows. I could manually remove if necessary.

Thanks

Champ007,

OK, let's see how the code below works for you.

I've made a couple of assumptions...
(1) Anything that begins with "(" is the Phone Number.
(2) Anything that contains an "@" is the Email Address.
(3) Anything that looks like a date is the Date value.

Regards,
Brian

Sub Reformat_List()
Dim xCell As Range
Dim xInputSheet As Worksheet
Dim xOutputSheet As Worksheet
Dim xLastRow As Long
Dim i As Long
Dim xName As String
Dim xCompany As String
Dim xDivision As String
Dim xEmail As String
Dim xPhone As String
Dim xTitle As String

Set xInputSheet = ActiveSheet
Set xOutputSheet = Sheets.Add
xOutputSheet.Range("A1:F1").Value = Array("Name", "Company", "Division", "Email Address", "Phone", "Title")
i = 2

xInputSheet.Activate
xLastRow = ActiveSheet.Range("A1").SpecialCells(xlLastCell).Row

For Each xCell In xInputSheet.Range("A1:A" & xLastRow)
    
    If xCell.Offset(0, 1) <> "" Then
        xName = xCell
        xTitle = xCell.Offset(0, 1)
    Else
        If xCell = "" Then
            ' Ignore blank rows
        ElseIf InStr(1, xCell, "@") > 0 Then
            xEmail = xCell
        ElseIf Left(xCell, 1) = "(" Then
            xPhone = xCell
        ElseIf IsDate(xCell) Then
            ' Ignore Date
        ElseIf xCell.Offset(-1, 1) <> "" Then
            xCompany = xCell
        Else
            xDivision = xCell
        End If
        
        If xCell.Offset(1, 1) <> "" Or xCell.Row = xLastRow Then
            xOutputSheet.Cells(i, 1) = xName
            xOutputSheet.Cells(i, 2) = xCompany
            xOutputSheet.Cells(i, 3) = xDivision
            xOutputSheet.Cells(i, 4) = xEmail
            xOutputSheet.Cells(i, 5) = xPhone
            xOutputSheet.Cells(i, 6) = xTitle
            xName = ""
            xCompany = ""
            xDivision = ""
            xEmail = ""
            xPhone = ""
            xTitle = ""
            i = i + 1
        End If
    
    End If
Next

End Sub

Select all Open in new window

Champ007,

Oops, it doesn't handle a blank row immediately after Name. Please replace line 36 by the following...

 

ElseIf xCompany = "" Then

Select all Open in new window

Regards,
Brian.

Very Nice!!!

Thanks Redmondb. That was an outstanding - over the top solution. Very much appreciated.

Great! Thanks, Champ007.