This is the format of the data that I presently have:
Part No. | Manufacturer Name | Mfr. Part No.|
1 | China | 2
1 | Germany | 35
1 | Italy | C5
2 | Mexico | 29
3 | |
4 | | A3
I cant get a macro so that it ends up in the format that I need:
Part No. | Manufacturer Name | Mfr. Part No.|
1 | China | 2 | Germany | 35 | Italy| C5
2 | Mexico | 29
3 | |
4 | | A3
Basically for items with the same part number but different manufacturers, I need to transpose the rows of manufacturer names along with Mfr. Part No and put it in the columns next to the corresponding part number.
Thank you for taking the time to read this post!
Transpose row to column macro
-
-
-
Re: Transpose row to column macro
jstar88,
To get the most precise answer, it is best to upload/attach a sample workbook (sensitive data scrubbed/removed) that contains an example of your raw data on one worksheet, and on another worksheet your desired results.
The structure and data types of the sample workbook must exactly duplicate the real workbook. Include a clear and explicit explanation of your requirements.
To attach your workbook, scroll down and click on the Go Advanced button, then scroll down and click on the Manage Attachments button.
Have a great day,
Stan -
Re: Transpose row to column macro
Hi jstar88,
If necessary, change the code lines marked with 'Change to suit' then try this:
Code
Display MoreSub Macro2() Dim strMyCol As String, _ strPartNo As String, _ strSortRangeTo As String Dim lngRowStart As Long, _ lngRowLast As Long, _ lngColPaste As Long, _ lngColLast As Long Dim rngCell As Range strMyCol = "A" 'Column containing your company's part number. Change to suit. lngRowStart = 4 'Starting Row number for the data. Change to suit lngRowLast = Cells(Rows.Count, strMyCol).End(xlUp).Row Application.ScreenUpdating = False 'Shift the same part number description across columns of that row. 'Note the manufacturer name and their part number must be adjacent to your _ company's part number. For Each rngCell In Range(strMyCol & lngRowStart & ":" & strMyCol & lngRowLast) 'Initial setting If strPartNo = "" And lngRowPaste = 0 Then strPartNo = rngCell.Value lngRowPaste = rngCell.Row 'Cut (move) identical 'strPartNo' variables ElseIf CStr(rngCell.Value) = strPartNo Then lngColPaste = Cells(lngRowPaste, Columns.Count).End(xlToLeft).Column + 1 Range(Cells(rngCell.Row, rngCell.Column + 1), Cells(rngCell.Row, rngCell.Column + 2)).Cut _ Destination:=Cells(lngRowPaste, lngColPaste) Range(strMyCol & rngCell.Row).ClearContents Else strPartNo = "" lngRowPaste = 0 End If Next rngCell 'Search for the last column entry by searching backwards through all columns. 'Source: [URL]http://www.ozgrid.com/VBA/ExcelRanges.htm[/URL] lngColLast = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 'Sort the entire dataset by the part number as will put the blank rows at the bottom strSortRangeTo = CStr(Range(Cells(lngRowLast, lngColLast), Cells(lngRowLast, lngColLast)).Address) Range(strMyCol & lngRowStart & ":" & strSortRangeTo).Sort Key1:=Range(strMyCol & lngRowStart), Order1:=xlAscending End Sub
Regards,
Robert
Participate now!
Don’t have an account yet? Register yourself now and be a part of our community!