Fordraiders
asked on
transpose rows to column data
excel 2010 vba
I have a list in Excel
That if the Number in column A is repeated. then its gets transposed to as many colmns as it needs depending on how many rows exist on the number in column A.
I have attached an example sheet with some data already transposed.
Thanks
fordraiders
The code belowe does not work
I have a list in Excel
That if the Number in column A is repeated. then its gets transposed to as many colmns as it needs depending on how many rows exist on the number in column A.
I have attached an example sheet with some data already transposed.
Thanks
fordraiders
The code belowe does not work
Looks like this
3755 BONNET Abrasives
3755 BONNET HVAC and Refrigeration
3755 BONNET Plumbing
3755 BONNET Cleaning
3755 BONNET Plumbing
3756 BOOK Reference and Learning Supplies
3756 BOOK Reference and Learning Supplies
3757 BOOM Material Handling
3757 BOOM Pneumatics
3758 BOOM Material Handling
3758 BOOM Pneumatics
end up like this
A B C D E F
3755 BONNET Abrasives HVAC and Refrigeration plumbing Cleaning Plumbing
3756 BOOK Reference and Learning Supplies Reference and Learning Supplies
3757 BOOM Material Handling Pneumatics
3758 BOOM Material Handling Pneumatics
Sub ColsToRows()
Dim cRow As Long 'Row we're cutting from
Dim pRow As Long 'Row we're pasting to
Dim codeCol As String 'Column containing list of names
codeCol = "A"
cRow = 10
pRow = 2
Do While Range(codeCol & cRow).Value <> ""
If Range(codeCol & cRow).Value = Range(codeCol & pRow).Value Then
Range(codeCol & pRow).End(xlToRight).Offset(0, 1).Value = Range(codeCol & cRow).Offset(0, 1)
Range(codeCol & cRow).EntireRow.ClearContents
Else
pRow = pRow + 1
If pRow = cRow Then Exit Do
Range(Range(codeCol & cRow).Address, Range(codeCol & cRow).Offset(0, 1).Address).Copy Destination:=Range(codeCol & pRow)
Range(codeCol & cRow).EntireRow.ClearContents
End If
cRow = cRow + 1
Loop
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
took out column headers and some blank rows.
worked fine.
worked fine.
ASKER
Code = inWs.Cells(inRow, codeCol).Value <----------------
I have attached my file...
2dp-Request.xlsm