Help with Transposing

[GoranH]

Here's an example:

John	apple
John	fridge
John	heart
John	pear
John	car
Steven	soap
Steven	display
Steven	pen
Steven	orange
Steven	bee

<tbody>
</tbody>

I would like it to look like,

John	apple	fridge	heart	pear	Car
Steven	soap	display	pen	orange	bee

<tbody>
</tbody>

My sheet is mostly consisting of numbers, and there might be some "" blanks.
Any help (and explanation) would be greatly appreciated,

Regards!

 

[nemmi69]

Try this

Option Explicit
Dim CurName As String
Dim CurRow As Long
Dim CurCol As Long
Dim ListLoop As Long
Dim LastRowNo As Long


Sub TransposeList()
'Assuming lsts starts at A1
'Output will start at D1


CurRow = 1
CurCol = 4
LastRowNo = ActiveWorkbook.Worksheets("Sheet1").Range("A65536").End(xlUp).Row 'Or 1048576 if sheet has that many rows
CurOK = False
CurName = ""


For ListLoop = 1 To LastRowNo
    If CurName = ActiveWorkbook.Worksheets("Sheet1").Range("A" & ListLoop).Value Then
        CurCol = CurCol + 1
        ActiveWorkbook.Worksheets("Sheet1").Cells(CurRow, CurCol).Value = ActiveWorkbook.Worksheets("Sheet1").Range("B" & ListLoop).Value
    Else
        CurRow = CurRow + 1
        CurCol = 4
        CurName = ActiveWorkbook.Worksheets("Sheet1").Range("A" & ListLoop).Value
        ActiveWorkbook.Worksheets("Sheet1").Cells(CurRow, CurCol).Value = CurName
        CurCol = CurCol + 1
        ActiveWorkbook.Worksheets("Sheet1").Cells(CurRow, CurCol).Value = ActiveWorkbook.Worksheets("Sheet1").Range("B" & ListLoop).Value
    End If
    If CurName = "" Then
        CurName = ActiveWorkbook.Worksheets("Sheet1").Range("A" & ListLoop).Value
        ActiveWorkbook.Worksheets("Sheet1").Cells(CurRow, CurCol).Value = CurName
        CurCol = CurCol + 1
        ActiveWorkbook.Worksheets("Sheet1").Cells(CurRow, CurCol).Value = ActiveWorkbook.Worksheets("Sheet1").Range("B" & ListLoop).Value
    End If
Next ListLoop


End Sub

 

[GoranH]

Try this

Option Explicit
Dim CurName As String
Dim CurRow As Long
Dim CurCol As Long
Dim ListLoop As Long
Dim LastRowNo As Long


Sub TransposeList()
'Assuming lsts starts at A1
'Output will start at D1


CurRow = 1
CurCol = 4
LastRowNo = ActiveWorkbook.Worksheets("Sheet1").Range("A65536").End(xlUp).Row 'Or 1048576 if sheet has that many rows
CurOK = False
CurName = ""


For ListLoop = 1 To LastRowNo
    If CurName = ActiveWorkbook.Worksheets("Sheet1").Range("A" & ListLoop).Value Then
        CurCol = CurCol + 1
        ActiveWorkbook.Worksheets("Sheet1").Cells(CurRow, CurCol).Value = ActiveWorkbook.Worksheets("Sheet1").Range("B" & ListLoop).Value
    Else
        CurRow = CurRow + 1
        CurCol = 4
        CurName = ActiveWorkbook.Worksheets("Sheet1").Range("A" & ListLoop).Value
        ActiveWorkbook.Worksheets("Sheet1").Cells(CurRow, CurCol).Value = CurName
        CurCol = CurCol + 1
        ActiveWorkbook.Worksheets("Sheet1").Cells(CurRow, CurCol).Value = ActiveWorkbook.Worksheets("Sheet1").Range("B" & ListLoop).Value
    End If
    If CurName = "" Then
        CurName = ActiveWorkbook.Worksheets("Sheet1").Range("A" & ListLoop).Value
        ActiveWorkbook.Worksheets("Sheet1").Cells(CurRow, CurCol).Value = CurName
        CurCol = CurCol + 1
        ActiveWorkbook.Worksheets("Sheet1").Cells(CurRow, CurCol).Value = ActiveWorkbook.Worksheets("Sheet1").Range("B" & ListLoop).Value
    End If
Next ListLoop


End Sub

Hey mate, thanks for the code... I assume it's VBA, and I'm gona run it as a module. But I'm new to this, so further help would be appreciated.
I have column A which is the Johns/Stevens etc. and column B which is the items related to them. There can be blank values in column B.
And it's sheet "Sheet1", spanning from A1:B11053. So 11053 Rows including Header.

At the moment I'm getting "Compile Error - Variable not Defined", and pointing toward "Sub Transpose List". So what do I need to enter/change to make it work?
Regards.

 

[nemmi69]

Sorry, my bad. The CurOK = False line is not needed any more.

 

[GoranH]

Sorry, my bad. The CurOK = False line is not needed any more.

Works like a charm! Thx!