Looping question for 2 columns

  • Thread starter Thread starter lance-news
  • Start date Start date
L

lance-news

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
 
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
 
Back
Top