Macro/Formula | Add n Rows and Transpose n Columns to Single Column


I have a dataset (please find a sterilized example copy attached) that has a SKU and its associated BOM for each record. I derived this by using the 'Text to Columns' feature on comma-separated lists of SKU BOMs. I would like to stack all of the individual BOM items in one column. Naturally, there are a varying amount of BOM items in each BOM, such that the number of rows to add in under each SKU varies accordingly. I'm hoping someone can help me find the best way (macro, formula, or otherwise) to:

  1. Insert the appropriate number of rows underneath the desired SKU
  2. Transpose the BOM items to a column such that all BOM items are stacked one on top of the other.
  3. *Bonus Points* Copy the original SKU into the first column of the newly inserted rows so that each BOM item is still associated with its SKU.

Doing this process manually isn't too bad, but I've got nearly 10,000 SKUs to work on :/

Please let me know if my question requires any additional clarification! Thank you in advance for your time and consideration.



Selected Answer

This code should do the job. Please paste it to a standard code module.

Sub Format_BOM()
    ' Variatus @TeachExcel 20 Feb 2020
    Dim Ws As Worksheet
    Dim Tbl As ListObject
    Dim Arr As Variant
    Dim R As Long, C As Long
    Set Ws = Worksheets("Start (2)")        ' change to suit
    ' this presumes that there is only one table in Ws
    Set Tbl = Ws.ListObjects(1)
    Application.ScreenUpdating = False
    Tbl.ShowTableStyleRowStripes = False
    With Tbl.DataBodyRange
        For R = .Rows.Count To 1 Step -1
            C = WorksheetFunction.CountA(.Rows(R))
            If C > 1 Then
                Arr = .Rows(R).Value
                ReDim Preserve Arr(1 To 1, 1 To WorksheetFunction.CountA(.Rows(R)))
                For C = UBound(Arr, 2) To 2 Step -1
                    Tbl.ListRows.Add (R + 1)
                    .Cells(R + 1, 1).Value = Arr(1, 1)
                    .Cells(R + 1, 2).Value = Arr(1, C)
                Next C
            End If
        Next R
    End With
    With Application
        .ScreenUpdating = True
        .StatusBar = "All done"
    End With
End Sub

Sub ApplyRowColor()

    Dim Arr As Variant
    Dim R As Long
    With ActiveSheet.ListObjects(1).DataBodyRange
        .Interior.Pattern = xlNone
        Arr = .Columns(1).Value
        For R = 1 To UBound(Arr)
            On Error Resume Next
            If Arr(R, 1) <> Arr(R - 1, 1) Then
                .Rows(R).Interior.Color = 13561798
            End If
        Next R
    End With
End Sub

The procedure is installed in the attached workbook. Let me know if you need further help.

Edit Feb 20, 2020   ===============================

There were some inaccuracies in my original post dated Feb 14. These have been resolved. The attachment was replaced. In the new version row coloring is applied in a separate procedure which can also be called independently to apply row coloring to sheets which have been formatted previously.



Hey Variatus,

Thanks for the help! Unfortunately, I wasn't as clear as I should have been with the structure of my table.

What I'm hoping is that the Macro will perform even when I arrange the records in random order. For example, the code provided fails when used on the table in the worksheet labeled 'Start (2)' if the table is sorted Z-A. It seems to fail when I sort the table in any way other than the original sorting. The table I'm working with randomly shifts from one or two BOM items to seven, then up to twelve, then back down to four - it's very all over the place.

Any adjustments you could make would be much appreciated!
ConnorL (rep: 4) Feb 14, '20 at 8:59 am
My code should be insensitive to sort order. Please check and advise.
The problem hails from your workflow about which you unfortunately continue to provide insufficient information. Admittedly it's hard. I can't put my questions in one sentence, either. Start with, why are your source data in a table? Must they be that? My code should work on any size of table. The problem you describe seems to indicate that you abandon the use of a table when you add rows with more columns. Can you avoid doing that? Do you need to sort and filter after my program has run? Anyway, all bets are off if sorting a table prior to running my macro affects its functionality. That shouldn't be. Check and enable me to replicate the error so that I can eliminate it.
Variatus (rep: 3928) Feb 14, '20 at 7:35 pm
Hey Variatus,

Thanks for getting back to me! Please pardon me on my delayed response.

Note I've added an attachment with sheets labeled 'Before' and 'After' to showcase a section of my table before and after running your code.

Regarding my workflow:
1. Identify the next unique SKU.
2. Count the number of cells after column 'B' that contain a BOM item.
3. Add that number of rows underneath the unique SKU in focus.
4. Transpose the BOM items into the newly created rows in column 'B.'
5. Copy the unique SKU down into the newly created rows.
6. Repeat.

To be clear, no need to highlight anything. I highlighted some things in the hope of providing clarity; please don't feel the need to replicate that highlighting.

To try and answer some of your questions:
 - I generally work in tables; they help to clarify the data for presentation. I would be comfortable working outside of a table if necessary, but would generally prefer to maintain one.

 - I will be deleting all columns beyond column 'B' after all of the BOM items have stacked into column 'B,' and will be sorting 'B' alphabetically.

Thank you for your time and consideration! I appreciate any additional help you can provide. Please let me know if you have any further questions or concerns, or even advice on how better to utilize your macro/excel generally.
ConnorL (rep: 4) Feb 18, '20 at 4:17 pm
To express my sentiment in plain English, that was very sloppy programming on my part and I apologise for any inconvenience this has caused you. I hope the revised version is now free from errors.
Variatus (rep: 3928) Feb 19, '20 at 5:49 am
Hey Variatus,

The updated code seems to be working beautifully! Please, no apologies necessary!

Thank you for being patient with me and for all of your help in solving this problem. You did an excellent job.

I'll let you know if I run into any oddities or issues.

Thank you again!
ConnorL (rep: 4) Feb 20, '20 at 10:21 am
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login