'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