I have been working on putting together a VBA Macro to loop through a list of Item codes to build a complete bill of materials that drills down into each Sub-Level of the starting item code to help show cost increases at each item level.
The starting top level parent item code is located in the "Load List" sheet, which then sets the values in the "Search & Filter BOM" sheet for an Excel 365 Filter formula to return the starting top level Father item codes child items from a table that contains every BOM we currently use. The returned values are then copied to column "J" in the "Auto Assembly Builder" sheet which checks if any of the pasted child items also have a BOM and gives them a value of 1 in column "X", or column "W". the Column "X" value is assigned if the child item originates from the starting top level father item code, and the Column "W" value is assigned if the child item code has a BOM and does not originate from the starting top level father item code.
The Macro then repeats the filter function on the "Search & Filter BOM" sheet using the Father item code and child item in columns "S" & "T" of the "Auto Assembly Builder" sheet if the value in column "X" = 1 and pastes the returned values from the "Search & Filter BOM" Sheet into the "Auto Assembly Builder" sheet below the BOM that was pasted earlier for the starting top level father item. Before returning to repeat the above for the next valid value (1) in column "X", a similar loop is completed first for all the valid values (1) in column "W", which builds the sub-level BOM's to their last level.
The trouble i am having is that i need the macro to loop back to the if statement used for the valid values in column "X" once all the values in column "W" have been completed (Changed from 1 to 0). Then once all of the values in column "X" have been completed the values in columns "J4:P" are copied to the "Completed BOM Paste Table" sheet, skipping any values that have already been pasted there by the macro earlier. (the "4" in "J4:P" skips the rows i use for a column index, loaded row count and the table headers on the "Auto Assembly Builder" sheet)
I am still quite new to VBA, so if i have missed any information or need to clarify something further please let me know.
Here is the code i have prepared so far;
Sub Select_Sublevel_Item_Codes_To_Copy_And_Paste_For_BOM_Load()
Dim Wbk As Workbook: Set Wbk = Workbooks("Automated Filter Function BOM Cost Reviewer (Macro Test).xlsm")
Dim Ws1 As Worksheet: Set Ws1 = Wbk.Sheets("Search & Filter BOM")
Dim Ws2 As Worksheet: Set Ws2 = Wbk.Sheets("Auto Assembly Builder")
Dim Ws3 As Worksheet: Set Ws3 = Wbk.Sheets("Load List")
Dim Ws4 As Worksheet: Set Ws4 = Wbk.Sheets("Completed BOM Paste Table")
Dim LR As Long, Lrow As Long, H As Long, i As Long, j As Long, k As Long, L As Long
Application.EnableCancelKey = xlInterrupt
'`Copies the top level father item code in the "Load List" sheet`
With Ws3
LR = .Range("B" & Rows.Count).End(xlDown).Row
For H = 3 To LR
'Finds the next top level father item code to use as a value in the "Search & Filter BOM" Sheet`
With .Range("C" & H)
If .Value = "Load" Then
Ws1.Activate
'`Destination for the found top level father item code, the same found top level father item code is used in A2 & B2, as the formula in Column "X" on the "Auto Assembly Builder" sheet needs this to set a value for the next loop (For i)`
Range("A2").Value = Ws3.Range("B" & H)
Range("B2").Value = Ws3.Range("B" & H)
'`Copies the returned results from Excel 365's filter formula on the "Search & Filter BOM" Sheet`
Ws1.Activate
With Ws1
'`Finds the last row of the returned results`
Lrow = .Range("B" & Rows.Count).End(xlUp).Row
.Range("B4:H" & Lrow).Copy
'`Pastes the copied values into the "Auto Assembly Builder" sheet in the first row of the table in Column "J"`
Ws2.Activate
With Ws2
.Range("Auto_Assembly_Builder_Table").Cells(1, 10).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
End With
End If
On Error Resume Next
End With
'`Finds the father & Child item code in the "Auto Assembly Builder" sheet to use in the "Search & Filter BOM" sheet, the results are then copied and Pasted in the first blank row of the table in Column "J" on the "Auto Assembly Builder" Sheet`
With Ws2
LR = .Range("X" & Rows.Count).End(xlUp).Row
For i = 4 To LR
With .Range("x" & i)
'`Finds the next row containing a child item of the top level father item that also has a BOM`
If .Value = "1" Then
Ws1.Activate
'`Destination for the found father item code in Column "S" on the "Auto Assembly Builder" sheet`
Range("A2").Value = Ws2.Range("S" & i)
'`Destination for the found Child item code in Column "T" on the "Auto Assembly Builder" sheet`
Range("B2").Value = Ws2.Range("T" & i)
'`Copies the returned results from Excel 365's filter formula on the "Search & Filter BOM" Sheet`
Ws1.Activate
With Ws1
Lrow = .Range("B" & Rows.Count).End(xlUp).Row
.Range("B4:H" & Lrow).Copy
'`Pastes the copied values into the "Auto Assembly Builder" sheet in the first blank row of the table in Column "J"`
Ws2.Activate
With Ws2
.Range("Auto_Assembly_Builder_Table").Cells(1, 10).End(xlDown).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
End With
End If
End With
'`Finds the father & Child item code in the "Auto Assembly Builder" sheet to use in the "Search & Filter BOM" sheet, the results are then copied and Pasted in the first blank row of the table in Column "J" on the "Auto Assembly Builder" Sheet`
With Ws2
LR = .Range("W" & Rows.Count).End(xlUp).Row
For j = 4 To LR
With .Range("W" & j)
If .Value = "1" Then
Ws1.Activate
Range("A2").Value = Ws2.Range("S" & j)
Range("B2").Value = Ws2.Range("T" & j)
Ws1.Activate
With Ws1
Lrow = .Range("B" & Rows.Count).End(xlUp).Row
.Range("B4:H" & Lrow).Copy
Ws2.Activate
With Ws2
.Range("Auto_Assembly_Builder_Table").Cells(1, 10).End(xlDown).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
End With
End If
End With
`Repeats the loop above to select the child items of the previously loaded BOM, but reverses the selection to dril down into the previously loaded BOM, before loading the next secondary BOM level that was loaded from Column "X"`
With Ws2
LR = .Range("W" & Rows.Count).End(xlDown).Row
For k = 4 To LR
With .Range("W" & k)
If .Value = "1" Then
Ws1.Activate
Range("A2").Value = Ws2.Range("S" & k)
Range("B2").Value = Ws2.Range("T" & k)
Ws1.Activate
With Ws1
Lrow = .Range("B" & Rows.Count).End(xlUp).Row
.Range("B4:H" & Lrow).Copy
Ws2.Activate
With Ws2
.Range("Auto_Assembly_Builder_Table").Cells(1, 10).End(xlDown).Offset(1).PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
End With
End If
End With
'`This is where the loop is breaking, as once all valid values have been loaded for "K" there is nothing to stop it from looping through invalid values`
Next k
End With
Next j
End With
Next i
End With
'`Copies the complete top father item code assembly from the "Auto Assembly Builder" sheet in columns "J4:P" to the last row non blank row in the table`
Ws2.Activate
With Ws2
Lrow = Cells(Range("Auto_Assembly_Builder_Table").Rows.Count,
"J").End(xlUp).Offset(1).Find(What:="", LookIn:=xlValues, LookAt:=xlWhole).Row
.Range("Auto_Assembly_Builder_Table J4:P" & Lrow - 1).Copy
'`Pastes the copied complete assembly to the first blank row in column "C" on the "Completed BOM Paste Table" sheet`
Ws4.Activate
With Ws4
.Range("Completed_BOM_Paste_Table").Cells(1, 3).End(xlDown).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Ws2.Activate
With Ws2
'`Clears the complete assembly that was just copied on the "Auto Assembly Builder" sheet in columns "J4:P", ready for the next assembly to be loaded`
Lrow = Cells(Range("Auto_Assembly_Builder_Table").Rows.Count, "J").End(xlUp).Offset(1).Find(What:="", LookIn:=xlValues, LookAt:=xlWhole).Row
.Range("Auto_Assembly_Builder_Table J4:P" & Lrow - 1).Clear
End With
End With
End With
Next H
End With
End Sub
Aucun commentaire:
Enregistrer un commentaire