split BOM by reference designators

[22strider]

Hello Friends

Could anyone please help figuring out macro (VBA routine) for the following?
The original spreadsheet has bill of materials (BOM) export with columns ParentItem, ChildItem, Qty and RefDesig. Following is the sample table:
ParentItem Child Item Qty RefDesig
P12345 C12345 2 R12,R23
P12345 C45678 3 C56,C45,C89
P12345 C6598 4

Entries under column RefDesig are separated by comma.
I need a macro that would read and count entries under RefDesig and enter rows one each for RefDesig and change qty from its original number to 1. And if there is no RefDesig the Qty will remain as is.
Following is the table showing expected output:
ParentItem Child Item Qty RefDesig
P12345 C12345 1 R12
P12345 C12345 1 R23
P12345 C45678 1 C56
P12345 C45678 1 C45
P12345 C45678 1 C89
P12345 C6598 4

You may notice that the row one (in the original table) has been split into two rows (because in original table it had 2 reference designators) and the row two has been split into three rows. And row three in the original table remains as is in the result table because there was no reference designator.
Thanks
Rajesh

 

[hiker95]

so, after the range is resized, you continue to use the range that was resized as a source

ncrcnbl,

If fgg123 was to add new/additional data below the current expanded data, in the same format as the original data, the macro should be able to process just the new information correctly.

 

[wwwMKRDinfo]

I will use this old thread because it is (at least for me) on the very top of Gurgle search results.

I had a BOM that had more columns. So adding ability to have a BOM with more columns, and correcting minor typos from an otherwise excellent macro, I came up with the following:

Option Explicit
Sub SplitBOM()
' www.MKRD.info, 2022/08/01
' Modified from http://www.mrexcel.com/forum/showthread.php?t=613198
' Hardcoded location of RefDes: Column C.
' Hardcoded location of Qty: Column B.
' Hardcoded location of Other Data: Columns A and D thru L.
' Hardcoded RefDes delimiter: ", "

Dim r As Long, lr As Long, Sp, n As Long
Application.ScreenUpdating = False

'find the last used cell in column 3 = "C"
lr = Cells(Rows.Count, 3).End(xlUp).Row

'loop thru column 3 = "C"
'  from the last row to row 2
For r = lr To 2 Step -1
  
  'if RefDes cells in column 3 = "C" are blank
  '  or, the RefDes cell does not contain the ", " character
  '  then do nothing
  If Cells(r, 3) = "" Or InStr(Cells(r, 3), ", ") = 0 Then
    'do nothing
    
  'if the RefDes cell in column 3 = "C"
  '  contains the ", " character, then the
  '  InStr will be greater than 0
  ElseIf InStr(Cells(r, 3), ", ") > 0 Then
  
    'Sp is an array (Option Base 0)
    '  Split the cell in RefDes column 3 = "C" by the ", " character
    Sp = Split(Trim(Cells(r, 3)), ", ")
    
    'Insert row(s) at the next row down from row r
    'Older, longer method in forum post:
    'If the UBound(SP) = 1
    '  then insert 1 row
    'If the UBond(SP) = 2
    '  then insert 2 rows, .....
    'Newer, faster method suggested by forum post:
    Rows(r + 1).Resize(UBound(Sp)).Insert
    
    'Fill columns A and D thru L from row r to the number of rows inserted
    '  with the value in columns A and D thru L in row r
    ' Ref https://docs.microsoft.com/en-us/office/vba/api/excel.range.resize
    ' Modified for non-contiguous range (data split over two ranges)
    ' Old method that would have worked if Other Data is in a contiguous range:
    ' Cells(r, 1).Resize(UBound(Sp) + 1, 2).Value = Cells(r, 1).Resize(, 2).Value
    'New method Step 1: copy Column A:
    Cells(r, 1).Resize(UBound(Sp) + 1, 1).Value = Cells(r, 1).Resize(, 1).Value
    ' Step 2: copy Columns D thru L:
    Cells(r, 4).Resize(UBound(Sp) + 1, 9).Value = Cells(r, 4).Resize(, 9).Value
    
    'Fill the Qty cells in column 2 = "B"
    '  from row r to the number of rows inserted
    '  with the original value in Cells(r,2) divided by
    '  the number of rows inserted + 1
    Cells(r, 2).Resize(UBound(Sp) + 1) = Cells(r, 2) / (UBound(Sp) + 1)
    
    'Fill the RefDes cells in column 3 = "C"
    '  from row r to the number of rows inserted
    '  with the values from the Sp array
    Cells(r, 3).Resize(UBound(Sp) + 1) = Application.Transpose(Sp)
  End If
Next r

Application.ScreenUpdating = True
End Sub

I think comments are very clear as to what the code does, and they greatly aid in modifying this for any other BOMs that put this data into different columns.