• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Need help moving data from columns into rows

bendav0314

New Member
I'm working on a bill of materials that our company part number, manufacturer name, and manufacturer part number in columns (A,B,C). Our company part number may have one or more manufacturers for each part (maximum of 10). If there are more than one manufacturer, each are listed on separate rows. I need to move the additional data from rows into columns in the first row.


An example with 3 manufacturers - data in row 1,columns A,B,C; row 2,columns B,C (column A is blank); row 3, columns B,C (again column A is blank). I need to move row 2, columns B and C into row 1, columns D and E; then move row 3 columns B and C into row 1, columns F and G.


I need to do this for hundreds of part numbers (column A) with various numbers of manufacturers (columns B & C). I'm pretty sure there are no part numbers with more than 10 manufacturers. Normally company part number is blank for rows that list additional manufacturers, but I can fill the blanks in column A with duplicated part numbers if that makes the task easier.


I can do this manually, but it's a true time sink (and waaaayyy boring!)for hundreds of rows. I have little to no experience w/ macros or VBA, so I turn the collective knowledge of this forum.


Thanks in advance for any suggestions or help you can give.
 
Hi Bendav0314,


Welcome to Chandoo.org forums. Test the following code on a backup copy first.


To use the macro, right click on the sheet tab and choose "View Code". It will open Visual Basic Editor Window. Paste the code and then run it.

[pre]
Code:
Public Sub ProcessData()
Application.ScreenUpdating = False
For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
If Len(Range("A" & i).Value) = 0 Then
Range("B" & i).Resize(1, 2).Copy Range("A" & i).End(xlUp).End(xlToRight).Offset(0, 1)
End If
Next i
On Error Resume Next
Range("A1:A" & Range("B" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
[/pre]
 
Hi Shrivallabha,


Thanks for your kind welcome and assistance with my problem. The code works wonderfully! This will save me hours of tedious editing!


You have my sincere gratitude and thanks!


Ben
 
Back
Top