Need help organizing two columns according to row

Hey guys,

I am new to VBA, and I need help writing a macro that separates information according to the name indicated in the first column. I have attached a sample document of what I am starting with on Sheet1. Sheet2 shows basically what I want as the end product.

In the document, there are three columns. The first column indicates names, and then the other two columns correspond to the name specified. I want to write a macro that separates or filters the comments and numbers in the other two columns according to the name.

The best I can come up with is that the numbers column is blank when starting a new name, so maybe use that as a means to indicate the new name with a True/False statement, but I do not know how to write that code.

I have been struggling with the logic on this one for awhile, so any help you can provide will be greatly appreciated.

Thanks!

Sub organize()

Dim rx(100)

shout = "sheet3"

For i = 1 To 100
rx(i) = 1
Next i

r = 2
c = -3
Sheets("sheet1").Select
Nm = ""
While Cells(r, 1) & Cells(r, 2) & Cells(r, 3) <> ""
If Cells(r, 1) <> "" And Trim(Cells(r, 3)) = "" And Cells(r, 1) <> Nm Then
c = c + 4
Sheets(shout).Cells(1, c) = Cells(r, 1)
Sheets(shout).Cells(1, c).Font.Bold = Cells(r, 1).Font.Bold
Nm = Cells(r, 1)
Else
Sheets(shout).Cells(rx(c), c) = Cells(r, 1)
Sheets(shout).Cells(rx(c), c).Font.Bold = Cells(r, 1).Font.Bold
Sheets(shout).Cells(rx(c), c + 1) = Cells(r, 2)
Sheets(shout).Cells(rx(c), c + 2) = Cells(r, 3)
End If
rx(c) = rx(c) + 1
Nm = Cells(r, 2)

r = r + 1
Wend




End Sub

Thank you for your help. I am getting "Run-time error '9': Subscript out of range". Would you explain to me how to fix this error, or where I should go to read about how to fix it?

Thanks Again!

It ran for me....

My guess is that your data does not start in row 2.

send the line in which this error is shown

Line 20: Sheets(shout).Cells(1, c) = Cells(r, 1)

are you running the same workbookI modified?