Transpose Dynamic Ranges

[Ozbobeee]

Hi,

XL 2K

I have an list of names and addresses in column A that finishes in Row
56500.
The format is not consistent, with names/addresses ranging from 3 - 6
rows.
A blank row separates each name/address.

The format looks something like this:

Row 1 : Name
Row 2 : Address1 line 1
Row 3 : Address1 line 2
Row 4 : Blank
Row 5 : Name
Row 6 : Address2 line 1
Row 7 : Address2 line 2
Row 8 : Address2 line 3
Row 9 : Blank
Row 10 : Name
Row 11 : Address1 line 1
Row 12 : Address1 line 2
Row 13 : Blank
etc


Is it possible to loop through the range in Col A for each
name/address and then transpose into Cols B, B:E, B:F, or B:F
(dependent on the number of rows in the name/address in Col A).

TIA

Cheers

Bob
Maitland Australia

 

[Frank Kabel]

Hi
try the following macro:

Sub transpose_data()
Dim lastrow As Long
Dim row_index As Long
Dim trow As Long
Dim tcol As Integer
Dim source_wks As Worksheet
Dim target_wks As Worksheet

Set source_wks = Worksheets("sheet1")
Set target_wks = Worksheets("sheet2")
lastrow = source_wks.Cells(Rows.Count, 1).End(xlUp).Row
trow = 1
tcol = 1
Application.ScreenUpdating = False
For row_index = 1 To lastrow
If source_wks.Cells(row_index, 1).Value <> "" Then
target_wks.Cells(trow, tcol).Value = _
source_wks.Cells(row_index, 1).Value
tcol = tcol + 1
Else
tcol = 1
trow = trow + 1
End If
Next
Application.ScreenUpdating = False
End Sub

 

[Ozbobeee]

Many thanks Frank,

Works great.

Cheers

Bob

Hi
try the following macro:

Sub transpose_data()
Dim lastrow As Long
Dim row_index As Long
Dim trow As Long
Dim tcol As Integer
Dim source_wks As Worksheet
Dim target_wks As Worksheet

Set source_wks = Worksheets("sheet1")
Set target_wks = Worksheets("sheet2")
lastrow = source_wks.Cells(Rows.Count, 1).End(xlUp).Row
trow = 1
tcol = 1
Application.ScreenUpdating = False
For row_index = 1 To lastrow
If source_wks.Cells(row_index, 1).Value <> "" Then
target_wks.Cells(trow, tcol).Value = _
source_wks.Cells(row_index, 1).Value
tcol = tcol + 1
Else
tcol = 1
trow = trow + 1
End If
Next
Application.ScreenUpdating = False
End Sub