Looping question for 2 columns
 

Hello,

I have data as such:
A B
1 this is line 1 1
2 2
3 3
4 4
5 this is line 2 1
6 2
7 3
8 4


and want to change it to
A B C D E
this is line 1 1 2 3 4
this is line 2 1 2 3 4




I figure I want to find the first row in column A with a value in it and
then select row 1:4 and copy/paste select:transpose and then delete the
three rows below A1 before moving to A5 but I am not sure how to loop this.

I know how to determine how many lines in col B will need to be copy/pasted.

Dim WorkRange As Range
If TypeName(Selection) < "Range" Then Exit Sub
Set WorkRange = Range("B:B")
NumSegments = Application.Max(WorkRange)
MsgBox (NumSegments)


Any suggestions?

Lance

Looping question for 2 columns
 

Lance

Try this

Sub TPose()

Dim CurrLine As Range
Dim NoOfRows As Long
Dim i As Long

Set CurrLine = Sheet1.Range("a65536")

Do

Set CurrLine = CurrLine.End(xlUp)

If CurrLine.End(xlDown).Row = Sheet1.Rows.Count Then
NoOfRows = Sheet1.Range(CurrLine.Offset(0, 1), _
CurrLine.Offset(0, 1).End(xlDown)).Rows.Count
Else
NoOfRows = Sheet1.Range(CurrLine, CurrLine.End(xlDown)).Rows.Count -
1
End If

For i = 1 To NoOfRows - 1
CurrLine.Offset(0, i + 1).Value = CurrLine.Offset(i, 1).Value
Next i

CurrLine.Offset(1, 0).Resize(NoOfRows - 1).EntireRow.Delete

Loop Until CurrLine.Row = 1 Or IsEmpty(CurrLine.Offset(-1, 1))

End Sub

--
Dick Kusleika
MVP - Excel
www.dicks-clicks.com
Post all replies to the newsgroup.
wrote in message
...
Hello,

I have data as such:
A B
1 this is line 1 1
2 2
3 3
4 4
5 this is line 2 1
6 2
7 3
8 4


and want to change it to
A B C D E
this is line 1 1 2 3 4
this is line 2 1 2 3 4




I figure I want to find the first row in column A with a value in it and
then select row 1:4 and copy/paste select:transpose and then delete the
three rows below A1 before moving to A5 but I am not sure how to loop
this.

I know how to determine how many lines in col B will need to be
copy/pasted.

Dim WorkRange As Range
If TypeName(Selection) < "Range" Then Exit Sub
Set WorkRange = Range("B:B")
NumSegments = Application.Max(WorkRange)
MsgBox (NumSegments)


Any suggestions?

Lance