VBA to create Multi level Bill of Material from Single Level Bill Of Material

48 Views Asked by At

'I am trying to convert single level bill of material to multi level bill of material for multiple Finish goods, get some codes and 'this working, however when i add large data set in Sheet1 and list of Finish goods in Sheet2 for which bill of material is required. 'system hanged for more than hour but no output, please help me to simplify this code

Sub GenerateBOM()
    Dim wsSource1 As Worksheet
    Dim wsSource2 As Worksheet
    Dim wsOutput As Worksheet
    Dim currentRow As Long
    Dim parentCode As String
    Dim parentDesc As String
    
    ' Set your source worksheets
    Set wsSource1 = ThisWorkbook.Sheets("Sheet1") ' Source for BOM details
    Set wsSource2 = ThisWorkbook.Sheets("Sheet2") ' Source for finished goods list
    
    ' Set your output worksheet
    Set wsOutput = ThisWorkbook.Sheets.Add
    wsOutput.Name = "BOM_Output"
    
    ' Set the starting row in the output sheet
    currentRow = 1
    
    ' Output headers
    wsOutput.Cells(currentRow, 1).Value = "FG Code"
    wsOutput.Cells(currentRow, 2).Value = "Level"
    wsOutput.Cells(currentRow, 3).Value = "Parent Code"
    wsOutput.Cells(currentRow, 4).Value = "Parent Description"
    wsOutput.Cells(currentRow, 5).Value = "Child Code"
    wsOutput.Cells(currentRow, 6).Value = "Child Description"
    wsOutput.Cells(currentRow, 7).Value = "Qty"
    wsOutput.Cells(currentRow, 8).Value = "Total Qty"
    currentRow = currentRow + 1
    
    ' Loop through finished goods list from Sheet2
    Dim lastRow2 As Long
    lastRow2 = wsSource2.Cells(wsSource2.Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To lastRow2 ' Assuming the data starts from row 2 (headers are in row 1)
        parentCode = wsSource2.Cells(i, 1).Value
        parentDesc = wsSource2.Cells(i, 2).Value
        
        ' Call the recursive function to generate BOM for each finished good
        GenerateBOMLevel wsSource1, wsOutput, parentCode, parentDesc, 0, currentRow, parentCode
    Next i
    
    ' Autofit columns
    wsOutput.Columns("A:H").AutoFit
    MsgBox "BOM Generated Successfully!", vbInformation
End Sub

Sub GenerateBOMLevel(wsSource As Worksheet, wsOutput As Worksheet, parentCode As String, parentDesc As String, ByVal level As Integer, ByRef currentRow As Long, ByVal FGCode As String)
    Dim lastRow1 As Long
    Dim i As Long
    Dim childCode As String
    Dim childDesc As String
    Dim childQty As Variant
    
    ' Find the last row of the source worksheet (Sheet1)
    lastRow1 = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' Loop through each row of Sheet1
    For i = 2 To lastRow1 ' Assuming the data starts from row 2 (headers are in row 1)
        If wsSource.Cells(i, 1).Text = parentCode Then ' Use Text property to maintain text format
            ' Output parent item
            wsOutput.Cells(currentRow, 1).NumberFormat = "@" ' Set the cell format to text explicitly
            wsOutput.Cells(currentRow, 1).Value = FGCode
            wsOutput.Cells(currentRow, 2).Value = level
            wsOutput.Cells(currentRow, 3).NumberFormat = "@" ' Set the cell format to text explicitly
            wsOutput.Cells(currentRow, 3).Value = parentCode
            wsOutput.Cells(currentRow, 4).Value = parentDesc
            childCode = CStr(wsSource.Cells(i, 3).Value) ' Convert to string explicitly
            childDesc = wsSource.Cells(i, 4).Value
            childQty = wsSource.Cells(i, 6).Value
            wsOutput.Cells(currentRow, 5).NumberFormat = "@" ' Set the cell format to text explicitly
            wsOutput.Cells(currentRow, 5).Value = childCode
            wsOutput.Cells(currentRow, 6).Value = childDesc
            wsOutput.Cells(currentRow, 7).Value = childQty
            
            currentRow = currentRow + 1
            
            ' Recursively call the function to find children
            GenerateBOMLevel wsSource, wsOutput, childCode, childDesc, level + 1, currentRow, IIf(level = 0, parentCode, FGCode)
        End If
    Next i
End Sub

I am trying to convert single level bill of material to multi level bill of material for multiple Finish goods, get some codes and 'this working, however when i add large data set in Sheet1 and list of Finish goods in Sheet2 for which bill of material is required. 'system hanged for more than hour but no output, please help me to simplify this code

0

There are 0 best solutions below