• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 459
  • Last Modified:

How Do I create a cascading MS Excel macro

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
0
mcrouch1
Asked:
mcrouch1
1 Solution
 
Saqib Husain, SyedEngineerCommented:
You can help by uploading a sample excel file
0
 
mcrouch1Author Commented:
0
 
Saqib Husain, SyedEngineerCommented:
The numbers are already cascading. Do you want the cascading in different columns?
0
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
mcrouch1Author 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.
0
 
mcrouch1Author Commented:
Not just for this spreadsheet but for any report like this that gets exported into Excel.
0
 
Saqib Husain, SyedEngineerCommented:
One easy way is to use the Text-to-columns feature of excel.

For this first you would have to unmerge any cells in this region. Select the entire region and a few columns to the right also. press Ctrl-1, select alignment tab and uncheck "Merge cells"

Then select the one column which contains the numbers
Go to Data > Text to columns
select delimited
next
type a period (.) in the "other" box
and click on finish.

Saqib
0
 
Richard DanekeTrainerCommented:
Saqib keystrokes can be saved and re-used as a macro.
0
 
dlmilleCommented:
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
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Ruby Fundamentals

This course will introduce you to Ruby, as well as teach you about classes, methods, variables, data structures, loops, enumerable methods, and finishing touches.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now