Transpose groups of data of various sizes

I have a very long list of data in column B that is shown as follows:

Synergy Marketing & Design, Inc.
18321 Forest Road, Suite B
Lynchburg,*VA*24502
Brett Howell
(434) 363-4180

The Design Group
311 Rivermont Avenue
Lynchburg,*VA*24503
Nancy Marion
(434) 847-0939

Blair Marketing
2309 Atherholt Road
Lynchburg,*VA*24501
Kip Smith
(434) 846-2375

ProfitFindersUSA
Bedford,*VA
Gary Onks
(540) 427-6187

Lamar Advertising Company
3831 Old Forest Road Suite 6
Lynchburg,*VA*24501
Mark Snowden
(434) 385-4524
(800) 788-3009

I want to be able to transpose every set of data into rows like this:

Synergy Marketing & Design, Inc. 18321 Forest Road, Suite B Lynchburg,*VA*24502 Brett Howell (434) 363-4180
The Design Group 311 Rivermont Avenue Lynchburg,*VA*24503 Nancy Marion (434) 847-0939
Blair Marketing 2309 Atherholt Road Lynchburg,*VA*24501 Kip Smith (434) 846-2375
ProfitFindersUSA Bedford,*VA Gary Onks (540) 427-6187
Lamar Advertising Company 3831 Old Forest Road Suite 6 Lynchburg,*VA*24501 Mark Snowden (434) 385-4524 (800) 788-3009

The part I can't figure out is to be able to transpose sets of data that vary is size.

It would be great if there was a way to transpose the rows to a specific column if the row content is a Company Name, addreess, phone number.

Hi..

Private Sub CommandButton1_Click()
  Dim myArea As Range, myAreas As Areas
        With Sheets("Sheet1")
            With .Range("B1", .Range("B" & Rows.Count).End(xlUp))
                On Error Resume Next
                Set myAreas = .SpecialCells(2).Areas
                On Error GoTo 0
            End With
        
        For Each myArea In myAreas
            .Range("D" & .Range("D" & Rows.Count).End(xlUp).Row).Offset(1).Resize(1, myArea.Count).Value = Application.Transpose(myArea)
        Next myArea
    End With
End Sub

It would be great if there was a way to transpose the rows to a specific column if the row content is a Company Name, addreess, phone number.

That would be nice.. not sure how you would determine (by code), what goes where..

I guess if you wanted to adjust the data manually after it has been transposed.. this might at least make it faster..

Basically.. if you want to move some data to the right.. just double click on the cell.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("D2").CurrentRegion) Is Nothing Then
        Range(Target.Address).Insert shift:=xlToRight
    End If
End Sub

apo,

Thank you so very, very much.

I did test your code, and it did the trick.
I will study your code to learn something new.

I still need to do some more data manipulation (try to figure out if I can transpose to specific column based on data values) so I might be posting here again.

Thanks again

You're welcome..

The part I can't figure out is to be able to transpose sets of data that vary is size.

As your data had a nice blank row between each set.. using Areas was well suited.

As you can see.. I resized the amount of columns that the data would be transposed into by the Count of each Area.

This might help..

http://msdn.microsoft.com/en-us/libr...ffice.11).aspx

Just replace "a" with "b" for col. reference

http://www.mrexcel.com/forum/excel-q...ic-data-2.html

Sub test()
    Dim myAreas As Areas, myArea As Range, n As Long
    With Sheets("sheet1")
        With .Range("b1", .Range("b" & Rows.Count).End(xlUp))
            On Error Resume Next
            Set myAreas = .SpecialCells(2).Areas
            On Error GoTo 0
            If myAreas Is Nothing Then Exit Sub
            For Each myArea In myAreas
                n = n + 1
                If myArea.Rows.Count > 1 Then
                    Sheets("sheet2").Cells(n, 1).Resize(, myArea.Rows.Count).Value = _
                    Evaluate("transpose(sheet1!" & myArea.Address & ")")
                Else
                    Sheets("sheet2").Cells(n, 1).Value = myArea.Value
                End If
            Next
        End With
    End With
End Sub