I'm trying to create records from column data with a macro that will build a
range in a column, from a starting cell, that will add the next cell down
until it finds an empty cell. Then it will do a transpose on that range.
From the last cell in the range, it will repeat the sequence until it
reaches 2 empty cells or the end of the column or worksheet.

Because the lengths of the column cells vary, I can't just use an offset.

Any ideas are welcome,

Jim

I found this on the DG a while back:
Sub rearrange()

Dim curselection As Range
Dim i As Integer

Set curselection = Range("A1") 'or wherever you start

Do While curselection < ""

If Not curselection.Offset(1, 0) = "" Then
i = 1
Do
curselection.Offset(1, 0).Copy Destination:=curselection.Offset(0, i)
curselection.Offset(1, 0).EntireRow.Delete
i = i + 1
Loop Until curselection.Offset(1, 0) = ""
End If

curselection.Offset(1, 0).EntireRow.Delete
Set curselection = curselection.Offset(1, 0)

Loop

End Sub

HTH,
Ryan---


--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


"JIm Samson" wrote:

I'm trying to create records from column data with a macro that will build a
range in a column, from a starting cell, that will add the next cell down
until it finds an empty cell. Then it will do a transpose on that range.
From the last cell in the range, it will repeat the sequence until it
reaches 2 empty cells or the end of the column or worksheet.

Because the lengths of the column cells vary, I can't just use an offset.

Any ideas are welcome,

Jim

Ryan,
That was very helpful, I'm clicking Yes.
I just need to change the hardcoded cell A1 to whatever cell is active. It
shows me my original approach is wrnog and I still don't understand some
things but this will get the job done.
Thanks,
Jim

"ryguy7272" wrote in message
...
I found this on the DG a while back:
Sub rearrange()

Dim curselection As Range
Dim i As Integer

Set curselection = Range("A1") 'or wherever you start

Do While curselection < ""

If Not curselection.Offset(1, 0) = "" Then
i = 1
Do
curselection.Offset(1, 0).Copy Destination:=curselection.Offset(0, i)
curselection.Offset(1, 0).EntireRow.Delete
i = i + 1
Loop Until curselection.Offset(1, 0) = ""
End If

curselection.Offset(1, 0).EntireRow.Delete
Set curselection = curselection.Offset(1, 0)

Loop

End Sub

HTH,
Ryan---


--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.


"JIm Samson" wrote:

I'm trying to create records from column data with a macro that will
build a
range in a column, from a starting cell, that will add the next cell down
until it finds an empty cell. Then it will do a transpose on that range.
From the last cell in the range, it will repeat the sequence until it
reaches 2 empty cells or the end of the column or worksheet.

Because the lengths of the column cells vary, I can't just use an offset.

Any ideas are welcome,

Jim