We help IT Professionals succeed at work.

Check out our new AWS podcast with Certified Expert, Phil Phillips! Listen to "How to Execute a Seamless AWS Migration" on EE or on your favorite podcast platform. Listen Now

x

How Do I create a cascading MS Excel macro

mcrouch1
mcrouch1 asked
on
Medium Priority
466 Views
Last Modified: 2012-05-11
Image an assembly that contains 3 or 4 sub assemblies below it.  Level 1 is the top assembly, level 2-4 go into that top level assembly or part number.  When I export my BOM into an Excel spreadsheet all the part numbers fall below each other and I need them to cascade down according to the level they go into the part number above it.  My current BOM is made up of 1150 different part numbers or lines.  Those 1150 part numbers make up a few hundred assemblies.  I need a macro that will take the spreadsheet and cascade the part numbers by their assembly level.  Clear as mud lol?  Let me know if I need to explain further.  Thanks
Comment
Watch Question

Saqib HusainEngineer
CERTIFIED EXPERT

Commented:
You can help by uploading a sample excel file

Author

Commented:
Saqib HusainEngineer
CERTIFIED EXPERT

Commented:
The numbers are already cascading. Do you want the cascading in different columns?

Author

Commented:
Yes in different columns per the part numbers level.  So if its level 1 then have the part number in column 1, level 2 column 2, level 3 column 3, etc....Sorry, I didn't use the correct terminology.

Author

Commented:
Not just for this spreadsheet but for any report like this that gets exported into Excel.
Engineer
CERTIFIED EXPERT
Commented:
Unlock this solution with a free trial preview.
(No credit card required)
Get Preview
CERTIFIED EXPERT

Commented:
Saqib keystrokes can be saved and re-used as a macro.
Most Valuable Expert 2012
Top Expert 2012

Commented:
Not sure whether type or sequence comes before the levels or after.  I put them up front.

Here's the code:
Option Explicit
Type RowData
    lvl As Integer
    typ As String
    seq As Integer
    part As String
End Type

Sub GenerateCascadeOutput()
Dim mySheet As Worksheet
Dim rowProcess As RowData
Dim myRow As Range
Dim outCursor As Range
Dim outSheet As Worksheet
Dim maxLevels As Long, maxRange As Range, i As Integer
Dim WS As Worksheet
Dim chkRng As Range
Dim partLevels() As String, j As Integer
Dim xMsg As Long

    Set WS = Sheets("Import_File")
        
    On Error Resume Next
    Set outSheet = Sheets("Output_DB")
    outSheet.Name = "Output_DB"
    If Err.Number = 0 Then
        xMsg = MsgBox("Overwrite Output_DB?", vbYesNo, "Hit Yes to Overwrite")
        If xMsg = vbYes Then
            Application.DisplayAlerts = False
            Sheets("Output_DB").Cells.Clear
            Application.DisplayAlerts = True
        Else
            Exit Sub
        End If
    Else
        Set outSheet = Sheets.Add(after:=Sheets(Sheets.Count))
        outSheet.Name = "Output_DB"
    End If
    On Error GoTo 0

    
    WS.Select
    
    Set maxRange = Range("A1", Range("A" & Rows.Count).End(xlUp))
    maxLevels = Evaluate("MAX(" & maxRange.Address & ")")
    ReDim partLevels(maxLevels) As String
    
    outSheet.Range("A1:B1").Value = Array("TYPE", "SEQUENCE") 'use this if type/sequence come first
    
    Set outCursor = outSheet.Range("A2")
    
    For i = 1 To maxLevels
        outSheet.Cells(1, 3 + i - 1).Value = "LEVEL " & i 'use this if type/sequence come first
        'outSheet.Cells(1, i).Value = "LEVEL " & i 'comment out if type/sequence come second
    Next i
    
    'outSheet.Cells(1, maxLevels + 1).Resize(1, 2).Value = Array("TYPE", "SEQUENCE") 'comment out if type/sequence come second
    'minor changes, below, if type/sequence come second
    
    For Each myRow In maxRange.EntireRow
        If IsNumeric(myRow.Cells(1, 1).Value) Then
            If myRow.Cells(1, 1).Value > 0 Then
                rowProcess.lvl = myRow.Cells(1, 1).Value
                rowProcess.typ = myRow.Cells(1, 3).Value
                rowProcess.seq = myRow.Cells(1, 4).Value
                rowProcess.part = Replace(myRow.Cells(1, 5).Value, ".", "")
            
                outCursor.Value = rowProcess.typ
                outCursor.Offset(0, 1).Value = rowProcess.seq
                outCursor.Offset(0, 2 + rowProcess.lvl - 1).Value = rowProcess.part
                
                'now look up and set
                For j = rowProcess.lvl - 1 To 1 Step -1
                    outCursor.Offset(0, 2 + j - 1).Value = outCursor.Offset(-1, 2 + j - 1).Value
                Next j
                
                Set outCursor = outCursor.Offset(1, 0)
            Else
                'do nothing
            End If
        End If

    Next myRow
            
    outSheet.Select
    Range(Cells(1, 1), Cells(Rows.Count, maxLevels + 2)).AutoFilter

End Sub

Open in new window


See attached file demonstrating the output

Enjoy!

Dave
BOM-APR29-r1.xls
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a free trial preview!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.