# SP Delete Analysis generated on: 4/1/2025 4:06:48 PM --- ## Record Source - *None* ## Controls | Control Name | Reference | |--------------|-----------| | List86 (Row Source) | | | Combo12 (Row Source) | [[Tables/[Metals];]] | | TypeofMetal (Row Source) | [[Tables/[MetalPrices]] | | GaugeOfType (Row Source) | [[Tables/MetalPrices]] | ## VBA Code ```vba Option Compare Database Dim fromar(10), toar(10), curar(10), CurrSetSize(10), CurrSetGw(10), Sheets Dim BestSS(10, 3, 6) ' | ' +---------------------> 0 - Sheet Size ' 1 - Price for sheet ' 2 - Pounds used ' Private Sub BegLength_LostFocus() Call CalcIters End Sub Private Sub BegWidth_LostFocus() Call CalcIters End Sub Private Sub CalcIters() sz1 = Abs(EndWidth - BegWidth) If IncWidth <> 0 Then sz1 = sz1 / Abs(IncWidth) End If sz1 = sz1 + 1 sz2 = Abs(EndLength - BegLength) If IncLength <> 0 Then sz2 = sz2 / Abs(IncLength) End If sz2 = sz2 + 1 sz1 = sz1 * sz2 Iterations = Format$(sz1, "0") End Sub Private Sub cmdButtnCalc_Click() Dim MainDB As Database, MainSet As Recordset Dim MainDB2 As Database, MainSet2 As Recordset Set MainDB = DBEngine.Workspaces(0).Databases(0) Set MainDB2 = DBEngine.Workspaces(0).Databases(0) lblstatus.Caption = "Selecting Parts for Material Utilization" DoCmd.RunMacro "Material Selections for Utilitzation" lblstatus.Caption = "Selection Complete" Refresh lblstatus.Caption = "Moving Parts to AS400" Set MainSet = MainDB.OpenRecordset("RMSFILES#_IEMUP1A0") ' Create dynaset. Set MainSet2 = MainDB2.OpenRecordset("Util Selection 2") ' Create dynaset. lblstatus.Caption = "Purging AS400 product number file" MainSet.MoveFirst Do If Not (MainSet.EOF) Then MainSet.Delete DoEvents Else DoEvents Exit Do End If MainSet.MoveNext Loop lblstatus.Caption = "Purging AS400 result file" MainSet2.MoveFirst Do If Not (MainSet2.EOF) Then p$ = MainSet2!prt MainSet.AddNew MainSet!PRDNO = p$ MainSet.Update DoEvents Else DoEvents Exit Do End If MainSet2.MoveNext Loop lblstatus.Caption = "Activating AS400 Program" DoEvents ActiveXCtl24.DoClick lblstatus.Caption = "Retrieving Results" UtilResult1.SourceObject = "tricks" DoCmd.RunMacro "AS400 Utiliz Results" UtilResult1.SourceObject = "Util Result1" ' lblStatus.Caption = "Calculating material utilization on parts" lblstatus.Caption = "Done" End Sub Private Sub Command25_Click() Dim MainDB As Database, MainSet As Recordset Set MainDB = DBEngine.Workspaces(0).Databases(0) Set MainSet = MainDB.OpenRecordset("Util Selection C1") ' Create dynaset. Dim Main2DB As Database, Main2Set As Recordset Set Main2DB = DBEngine.Workspaces(0).Databases(0) Set Main2Set = Main2DB.OpenRecordset("Util Matrix") ' Create dynaset. BGW! = BegWidth EDW! = EndWidth ICW! = IncWidth BGL! = BegLength EDL! = EndLength ICL! = IncLength lb_per_sq_ft! = Density If lb_per_sq_ft! = 0 Then Call MsgBox("No density entered.") Exit Sub End If First = True For Sheet_Width! = BGW! To EDW! Step ICW! For Sheet_Length! = BGL! To EDL! Step ICL! SheetWidth = Sheet_Width! SheetLength = Sheet_Length! GoSub DoSheetSize Main2Set.AddNew Main2Set!Gw = TotalGw! Main2Set!SheetL = SheetLength Main2Set!sheetw = SheetWidth Main2Set.Update If (First) Or (LGrossWt > TotalGw!) Then LGrossWt = TotalGw! LSheetL = SheetLength LSheetW = SheetWidth First = False End If Next Next Cost = 0 Exit Sub DoSheetSize: lblstatus.Caption = "Calculate Gross Weight for all parts at this sheet" TotalGw! = 0 MainSet.MoveFirst Do If Not (MainSet.EOF) Then If MainSet!Flag <> 1 Then Sheet_Width! = SheetWidth Sheet_Length! = SheetLength Call UtilGrossWt(Sheet_Width!, Sheet_Length!, lb_per_sq_ft!, Gw!, Aw!, MainSet) TotalGw! = Gw! + TotalGw! End If DoEvents Else DoEvents Exit Do End If MainSet.MoveNext Loop Return End Sub Private Sub Command43_Click() On Error GoTo Err_Command43_Click Call Form.Command120_Click ' DoCmd.GoToRecord acDataForm, "UtilResult1", acNext Exit_Command43_Click: Exit Sub Err_Command43_Click: MsgBox Err.Description Resume Exit_Command43_Click End Sub Private Sub Command55_Click() lblstatus.Caption = "Running Query to pick parts for Material Utilization" DoCmd.RunMacro "Filter across Materials Utilitzation" lblstatus.Caption = "Selection Complete" Refresh End Sub Private Sub BestSheets_Click() Call GetTheBestAnswers End Sub Private Sub cmdCreate_Click() Dim MainDB As Database, MainSet As Recordset Set MainDB = DBEngine.Workspaces(0).Databases(0) Set MainSet = MainDB.OpenRecordset("Util L X W") ' Create dynaset. BGW! = BegWidth EDW! = EndWidth ICW! = IncWidth BGL! = BegLength EDL! = EndLength ICL! = IncLength For Sheet_Width! = BGW! To EDW! Step ICW! For Sheet_Length! = BGL! To EDL! Step ICL! MainSet.AddNew MainSet!SheetL = Sheet_Length! MainSet!sheetw = Sheet_Width! MainSet.Update Next Next Refresh End Sub Private Sub cmdLengths_Click() SheetWidths! = Val(AddWidths) Call Addparms(2, SheetWidths!) Refresh End Sub Private Sub cmdWidths_Click() SheetLength! = Val(AddLengths) Call Addparms(1, SheetLength!) Refresh End Sub Private Sub Command109_Click() On Error GoTo Err_Command109_Click Dim stDocName As String Command109.Tag = Command109.Caption Command109.Caption = "Processing" DoEvents DoCmd.SetWarnings (False) lblstatus.Caption = "Building C1 Records" ' stDocName = "Util Make Select 1" ' DoCmd.OpenQuery stDocName, acNormal, acEdit UtilResult1.SourceObject = "tricks" If Frame111 = 1 Then stDocName = "Util Result2" DoCmd.OpenQuery stDocName, acNormal, acEdit UtilResult1.SourceObject = "Util Result1" Else stDocName = "Util Result3" DoCmd.OpenQuery stDocName, acNormal, acEdit UtilResult1.SourceObject = "Util Result1" End If UtilResult1.SourceObject = "tricks" stDocName = "Util Set non zero usage parts to use" DoCmd.OpenQuery stDocName, acNormal, acEdit UtilResult1.SourceObject = "Util Result1" stDocName = "Util Set all zero usage parts to ignore" DoCmd.OpenQuery stDocName, acNormal, acEdit UtilResult1.SourceObject = "Util Result1" Exit_Command109_Click: lblstatus.Caption = "Done" Command109.Caption = Command109.Tag Exit Sub Err_Command109_Click: MsgBox Err.Description Resume Exit_Command109_Click End Sub Private Sub Command122_Click() ' Dim MainDB As Database, MainSet As Recordset Dim sh%(10), sl!(10), Sw!(10), desc$(10) Set MainDB = DBEngine.Workspaces(0).Databases(0) Set MainSet = MainDB.OpenRecordset("Util Selection C1") ' Create dynaset. Dim Main2DB As Database, Main2Set As Recordset Set Main2DB = DBEngine.Workspaces(0).Databases(0) Set Main2Set = Main2DB.OpenRecordset("Util L X W") ' Create dynaset. Main2Set.Index = "Primary Key" lb_per_sq_ft! = Density If lb_per_sq_ft! = 0 Then Call MsgBox("No density entered.") Command79.Enabled = True Exit Sub End If Sheets = Val(itsaNull$(NoOfSheets)) a1$ = itsaNull$(FavoriteSet) For i = 1 To Sheets sh%(i) = Val(a1$) cm = InStr(a1$, ",") If cm <> 0 Then a1$ = Mid$(a1$, cm + 1) Else a1$ = "" End If If sh%(i) <> 0 Then Key$ = Right$("0000000000" + Trim$(Str$(sh%(i))), 10) GoSub GetSheetSizer sl!(i) = Sheet_Length! Sw!(i) = Sheet_Width! desc$(i) = Format$(Sheet_Width!, "0.0") + " X " + Format$(Sheet_Length!, "0.0") Else sl!(i) = 0 Sw!(i) = 0 desc$(i) = "" End If Next ' SetNo TotalGw! = 0 MainSet.MoveFirst Do If Not (MainSet.EOF) Then If MainSet!Flag <> "1" Then FirstValid = 0 BestWt! = 0 BestSheet = 0 Bestlen! = 0 BestWth! = 0 For SetNo = 1 To Sheets Sheet_Length! = sl!(SetNo) Sheet_Width! = Sw!(SetNo) Call UtilGrossWt(Sheet_Width!, Sheet_Length!, lb_per_sq_ft!, Gw!, Aw!, MainSet) If (FirstValid = 0) And (Gw! <> 0) Then BestWt! = Gw! BestSheet = SetNo Bestlen! = Sheet_Length! BestWth! = Sheet_Width! FirstValid = 1 Exit For End If Next For SetNo = 1 To Sheets Sheet_Length! = sl!(SetNo) Sheet_Width! = Sw!(SetNo) Call UtilGrossWt(Sheet_Width!, Sheet_Length!, lb_per_sq_ft!, Gw!, Aw!, MainSet) If (BestWt! > Gw!) And (Gw! <> 0) Then BestWt! = Gw! BestSheet = SetNo Bestlen! = Sheet_Length! BestWth! = Sheet_Width! End If Next A$ = MainSet!PartNumber Call UtilGrossWt(BestWth!, Bestlen!, lb_per_sq_ft!, Gw!, Aw!, MainSet) MainSet.Edit If BestSheet = 0 Then MainSet!BestSheetSet = "BAD SHEETSET" Else MainSet!BestSheetSet = desc$(BestSheet) End If MainSet!GrossWt = Gw! MainSet!ActualWt = Aw! MainSet.Update End If DoEvents Else DoEvents Exit Do End If MainSet.MoveNext Loop Exit Sub GetSheetSizer: Main2Set.MoveFirst Main2Set.Seek "=", Key$ If Not (Main2Set.NoMatch) Then Sheet_Width! = Val(Main2Set!sheetw) Sheet_Length! = Val(Main2Set!SheetL) End If Return End Sub Private Sub Command130_Click() tx$ = Trim$(itsaNull$(txtSaveAs)) If tx$ <> "" Then DoCmd.CopyObject , tx$, acTable, "Util Selection C1" End If End Sub Private Sub Command133_Click() Dim MainDB As Database, MainSet As Recordset Dim MainDB2 As Database, MainSet2 As Recordset Set MainDB = DBEngine.Workspaces(0).Databases(0) Set MainDB2 = DBEngine.Workspaces(0).Databases(0) Command133.Tag = Command133.Caption Command133.Caption = "Processing" DoEvents lblstatus.Caption = "Selecting Parts for Material Utilization" DoCmd.RunMacro "Material Selections for Utilitzation" lblstatus.Caption = "Selection Complete" Refresh lblstatus.Caption = "Moving Parts to AS400" Set MainSet = MainDB.OpenRecordset("RMSFILES#_IEMUP1A0") ' Create dynaset. Set MainSet2 = MainDB2.OpenRecordset("Util Selection 2") ' Create dynaset. lblstatus.Caption = "Purging AS400 product number file" On Error Resume Next MainSet.MoveFirst On Error GoTo 0 Do If Not (MainSet.EOF) Then MainSet.Delete DoEvents Else DoEvents Exit Do End If MainSet.MoveNext Loop lblstatus.Caption = "Purging AS400 result file" MainSet2.MoveFirst Do If Not (MainSet2.EOF) Then p$ = MainSet2!prt MainSet.AddNew MainSet!PRDNO = p$ MainSet.Update DoEvents Else DoEvents Exit Do End If MainSet2.MoveNext Loop lblstatus.Caption = "Activating AS400 Program" DoEvents ActiveXCtl24.DoClick lblstatus.Caption = "Retrieving Results" UtilResult1.SourceObject = "tricks" DoCmd.RunMacro "AS400 Utiliz Results" UtilResult1.SourceObject = "Util Result1" ' lblStatus.Caption = "Calculating material utilization on parts" lblstatus.Caption = "Done" Command133.Caption = Command133.Tag End Sub Private Sub Command136_Click() UtilResult1.SourceObject = "tricks" UtilResult1.SourceObject = "Util Result1" End Sub Private Sub Command67_Click() Cost = PricePerPound * LGrossWt End Sub Private Sub Command68_Click() lblstatus.Caption = "Emptying Util Matrix" DoCmd.CopyObject "Util L X W", acTable, "Util Matrix Zero" End Sub Private Sub Command79_Click() ' Dim MainDB As Database, MainSet As Recordset Set MainDB = DBEngine.Workspaces(0).Databases(0) Set MainSet = MainDB.OpenRecordset("Util Selection C1") ' Create dynaset. Dim Main2DB As Database, Main2Set As Recordset Set Main2DB = DBEngine.Workspaces(0).Databases(0) Set Main2Set = Main2DB.OpenRecordset("Util L X W") ' Create dynaset. Dim Prices(4), Rg(4, 2) GoSub InitPricingPerLb Command79.Tag = Command79.Caption Command79.Caption = "Processing" DoEvents Main2Set.Index = "Primary Key" LGrossWt.SetFocus Command79.Enabled = False lb_per_sq_ft! = Density If lb_per_sq_ft! = 0 Then Call MsgBox("No density entered.") Command79.Enabled = True Exit Sub End If Sheets = Val(itsaNull$(NoOfSheets)) If Sheets > 10 Then MsgBox ("Too Many Sheets") Command79.Enabled = True Exit Sub End If If Sheets < 1 Then MsgBox ("No Sheets Entered") Command79.Enabled = True Exit Sub End If MainSet.MoveFirst Do If Not (MainSet.EOF) Then If MainSet!Flag <> "1" Then If Val(itsaNull(MainSet!USAGE)) = 0 Then PN$ = MainSet!PartNumber MsgBox ("USAGE=0 for Partnumber: " + PN$) Command79.Enabled = True Exit Sub End If End If Else Exit Do End If MainSet.MoveNext Loop For SetNo = 0 To 10 For i = 0 To 3 For j = 0 To 6 BestSS(SetNo, i, j) = 0 Next Next 'CurrSetSize(SetNo) = 0 Next Cost = 0 ' ' Count up the number of iterations to go through ' NoOfIters% = 0 lblstatus.Caption = "Numbering Iterations" Main2Set.MoveLast Main2Set.Edit Main2Set!idno = "AAA" Main2Set.Update Main2Set.MoveFirst Set Main2Set = Main2DB.OpenRecordset("Util L X W") ' Create dynaset. Do If Not (Main2Set.EOF) Then NoOfIters% = NoOfIters% + 1 Main2Set.Edit Main2Set!idno = Right$("0000000000" + Trim$(Str$(NoOfIters%)), 10) Main2Set.Update DoEvents Else DoEvents Exit Do End If Main2Set.MoveNext If Not (Main2Set.EOF) Then If (Main2Set!idno = "AAA") Then NoOfIters% = NoOfIters% + 1 Main2Set.Edit Main2Set!idno = Right$("0000000000" + Trim$(Str$(NoOfIters%)), 10) Main2Set.Update Exit Do End If End If Loop Set Main2Set = Main2DB.OpenRecordset("Util L X W") ' Create dynaset. Main2Set.Index = "Primary Key" lblstatus.Caption = "Calculate Gross weight" If NoOfIters% < Sheets Then MsgBox ("Not Enough Iterations") Command79.Enabled = True Exit Sub End If Iterations = NoOfIters% GoSub Init_Iterations FirstIter = True If NoOfIters% <> 1 Then Do GoSub CalcGWforSet ind = Sheets Do ' This loop bumps the CPH (current place holder) curar(ind) = curar(ind) + 1 If curar(ind) > toar(ind) Then ' IF the CPH exceed the limit fromar(ind) = fromar(ind) + 1 ' start the CPH at the from+1 curar(ind) = fromar(ind) ' and dec back to the prev PH ind = ind - 1 Else ib = curar(ind) ' Otherwise, all PH to the rt For ix = ind To Sheets ' should = CPH+1 curar(ix) = ib ib = ib + 1 Next Exit Do ' done End If Loop dn = 0 For ind = 1 To Sheets ' Check to see if all PHs If curar(ind) <> toar(ind) Then ' = the last toPHs dn = 1 ' if not loop to top Exit For End If Next If dn = 0 Then ' if so do the last one Exit Do End If Loop Else End If GoSub CalcGWforSet Main2Set.MoveFirst Do If Not (Main2Set.EOF) Then BSheet_Width! = Val(Main2Set!sheetw) BSheet_Length! = Val(Main2Set!SheetL) GoSub CalcGWforASheet Sheet_W = BSheet_Width: GoSub Pricing Main2Set.Edit Main2Set!GrossWeight = Format$(TotalGw!, "0.00") Main2Set!TotalPrice = Format$(TotalGw! * Price, "0.00") Main2Set!ErrCount = Format$(Terrs!, "0") Main2Set.Update DoEvents Else DoEvents Exit Do End If Main2Set.MoveNext Loop CurrentSheetSet = "" a1$ = "" a2$ = "" ttl# = 0 ttlgw# = 0 a2$ = Chr$(34) + "Width" + Chr$(34) + ";" + Chr$(34) + "Length" + Chr$(34) + ";" + Chr$(34) + " Price" + Chr$(34) + ";" + Chr$(34) + " Pounds" + Chr$(34) + ";" + Chr$(34) + " Price/Lb" + Chr$(34) + ";" + Chr$(34) + " Actual Wt" + Chr$(34) + ";" For SetNo = 1 To Sheets Key$ = Right$("0000000000" + Trim$(Str$(BestSS(SetNo, 0, 0))), 10) GoSub GetSheetSize a1$ = a1$ + " " + Trim$(Str$(Sheet_Width!)) + "X" + Trim$(Str$(Sheet_Length!)) + " =" + Format$(BestSS(SetNo, 1, 0), "$0") a2$ = a2$ + Chr$(34) + Trim$(Str$(Sheet_Width!)) + Chr$(34) + ";" a2$ = a2$ + Chr$(34) + Trim$(Str$(Sheet_Length!)) + Chr$(34) + ";" a2$ = a2$ + Chr$(34) + lpad$(Format$(BestSS(SetNo, 1, 0), "$##,###,##0"), 12) + Chr$(34) + ";" a2$ = a2$ + Chr$(34) + lpad$(Format$(BestSS(SetNo, 2, 0), "##,###,##0"), 12) + Chr$(34) + ";" If BestSS(SetNo, 2, 0) = 0 Then ppp = 0 Else ppp = BestSS(SetNo, 1, 0) / BestSS(SetNo, 2, 0) End If a2$ = a2$ + Chr$(34) + lpad$(Format$(ppp, "###0.00000"), 12) + Chr$(34) + ";" ttl# = ttl# + Val(Format(BestSS(SetNo, 1, 0), "0")) ttlgw# = ttlgw# + Val(Format(BestSS(SetNo, 1, 0), "0")) Next a2$ = a2$ + Chr$(34) + " " + Chr$(34) + ";" a2$ = a2$ + Chr$(34) + "Total " + Chr$(34) + ";" a2$ = a2$ + Chr$(34) + lpad$(Format$(ttl#, "$##,###,##0"), 12) + Chr$(34) + ";" a2$ = a2$ + Chr$(34) + lpad$(Format$(ttlgw#, "##,###,##0"), 12) + Chr$(34) + ";" a2$ = a2$ + Chr$(34) + lpad$(Format$(ttl# / ttlgw#, "###0.00000"), 12) + Chr$(34) BestSheetSet = a1$ List86.rowSource = a2$ UtilLXW.SourceObject = "tricks" UtilLXW.SourceObject = "Util L X W subform" lblstatus.Caption = "Done" Command79.Enabled = True Command79.Caption = Command79.Tag Exit Sub CalcGWforSet: TotalGw! = 0 TotalPrc! = 0 a1$ = "" For SetNo = 1 To Sheets a1$ = a1$ + Str$(curar(SetNo)) CurrSetSize(SetNo) = 0 CurrSetGw(SetNo) = 0 Next CurrentSheetSet = a1$ MainSet.MoveFirst ' search part file goodset = True Do If Not (MainSet.EOF) Then If MainSet!Flag <> "1" Then ' check the ignore flag BestWt! = 0 BestPrc! = 0 BestSet = 0 For SetNo = 1 To Sheets Key$ = Right$("0000000000" + Trim$(Str$(curar(SetNo))), 10) GoSub GetSheetSize Call UtilGrossWt(Sheet_Width!, Sheet_Length!, lb_per_sq_ft!, Gw!, Aw!, MainSet) Sheet_W = Sheet_Width: GoSub Pricing Prc! = Gw! * Price errc = Val(MainSet!CalculationStatus) If errc = 0 Then If (BestPrc! > Prc!) And (Prc! > 0) Then BestWt! = Gw! BestPrc! = Prc! BestSet = SetNo End If If (BestSet = 0) And (Prc! <> 0) Then BestWt! = Gw! BestPrc! = Prc! BestSet = SetNo End If End If Next If BestSet = 0 Then goodset = False Exit Do Else TotalGw! = BestWt! + TotalGw! TotalPrc! = BestPrc! + TotalPrc! CurrSetSize(BestSet) = CurrSetSize(BestSet) + BestPrc! CurrSetGw(BestSet) = CurrSetGw(BestSet) + BestWt! End If End If DoEvents Else DoEvents Exit Do End If MainSet.MoveNext Loop If goodset Then If FirstIter Then FirstIter = False BestSheetSet = CurrentSheetSet bestsetPrc! = TotalPrc! For top6 = 0 To 6 BestSS(0, 1, top6) = TotalPrc! BestSS(0, 2, top6) = TotalGw! Next For SetNo = 1 To Sheets For top6 = 0 To 6 BestSS(SetNo, 0, top6) = curar(SetNo) BestSS(SetNo, 1, top6) = CurrSetSize(SetNo) BestSS(SetNo, 2, top6) = CurrSetGw(SetNo) Next Next End If If (TotalPrc! < BestSS(0, 1, 6)) Then ' if this one is better than then sixth best insert it For worst2best = 5 To 1 Step -1 If (TotalPrc! > BestSS(0, 1, worst2best)) Then For SetNo = 0 To Sheets For top6 = 6 To worst2best + 1 Step -1 BestSS(SetNo, 0, top6) = BestSS(SetNo, 0, top6 - 1) BestSS(SetNo, 1, top6) = BestSS(SetNo, 1, top6 - 1) BestSS(SetNo, 2, top6) = BestSS(SetNo, 2, top6 - 1) Next Next For SetNo = 1 To Sheets BestSS(SetNo, 0, worst2best + 1) = curar(SetNo) BestSS(SetNo, 1, worst2best + 1) = CurrSetSize(SetNo) BestSS(SetNo, 2, worst2best + 1) = CurrSetGw(SetNo) Next BestSS(0, 1, worst2best + 1) = TotalPrc! BestSS(0, 2, worst2best + 1) = TotalGw! Exit For End If If (TotalPrc! <= BestSS(0, 1, worst2best)) And (worst2best = 1) Then For SetNo = 0 To Sheets For top6 = 6 To worst2best Step -1 BestSS(SetNo, 0, top6) = BestSS(SetNo, 0, top6 - 1) BestSS(SetNo, 1, top6) = BestSS(SetNo, 1, top6 - 1) BestSS(SetNo, 2, top6) = BestSS(SetNo, 2, top6 - 1) Next Next For SetNo = 1 To Sheets BestSS(SetNo, 0, worst2best) = curar(SetNo) BestSS(SetNo, 1, worst2best) = CurrSetSize(SetNo) BestSS(SetNo, 2, worst2best) = CurrSetGw(SetNo) Next BestSS(0, 1, worst2best) = TotalPrc! BestSS(0, 2, worst2best) = TotalGw! BestSheetSet = CurrentSheetSet BestSS(0, 1, 0) = TotalPrc! For SetNo = 1 To Sheets BestSS(SetNo, 0, 0) = curar(SetNo) BestSS(SetNo, 1, 0) = CurrSetSize(SetNo) BestSS(SetNo, 2, 0) = CurrSetGw(SetNo) Next ' Exit For End If Next End If End If Return GetSheetSize: Main2Set.MoveFirst Main2Set.Seek "=", Key$ If Not (Main2Set.NoMatch) Then Sheet_Width! = Val(Main2Set!sheetw) Sheet_Length! = Val(Main2Set!SheetL) End If Return Init_Iterations: For i = 1 To 10 fromar(i) = 0 toar(i) = 0 curar(i) = 0 Next j = Iterations - Sheets For i = 1 To Sheets fromar(i) = i curar(i) = i toar(i) = i + j Next Return CalcGWforASheet: TotalGw! = 0 Terrs! = 0 MainSet.MoveFirst goodset = True Do If Not (MainSet.EOF) Then If MainSet!Flag <> "1" Then Sheet_Width! = BSheet_Width!: Sheet_Length! = BSheet_Length! Call UtilGrossWt(Sheet_Width!, Sheet_Length!, lb_per_sq_ft!, Gw!, Aw!, MainSet) errc = Val(MainSet!CalculationStatus) If errc = 0 Then TotalGw! = Gw! + TotalGw! Else goodset = False Terrs! = Terrs! + 1 End If End If DoEvents Else DoEvents Exit Do End If MainSet.MoveNext Loop Return InitPricingPerLb: ' Dim Prices(4), Rg(4, 2) Prices(1) = Val(GaugeOfType.Column(1)) + Val(itsaNull$(BasePrice)) Prices(2) = Val(GaugeOfType.Column(2)) + Val(itsaNull$(BasePrice)) Prices(3) = Val(GaugeOfType.Column(3)) + Val(itsaNull$(BasePrice)) Prices(4) = Val(GaugeOfType.Column(4)) + Val(itsaNull$(BasePrice)) For i = 1 To 4 r$ = TypeofMetal.Column(i) rx = InStr(r$, "-") If rx = 0 Then Exit For Else Rg(i, 1) = Val(Left$(r$, rx - 1)) Rg(i, 2) = Val(Mid$(r$, rx + 1)) End If Next rgx = i - 1 Return 'Sheet_Width!, Sheet_Length!, lb_per_sq_ft!, Gw!, Aw!, MainSet Pricing: Price = -1 For i = 1 To rgx If (Sheet_W >= Rg(i, 1)) And (Sheet_W <= Rg(i, 2)) Then Price = Prices(i) Exit For End If Next If Price = -1 Then MsgBox ("Price range error") Stop End If Return End Sub Sub GiveAnswers(Sheets, XSize, Xincs) For i = 1 To Sheets Print Str$((curar(i) - 1) * Xincs + XSize) + " "; Next Print End Sub Private Sub EndLength_LostFocus() Call CalcIters End Sub Private Sub EndWidth_LostFocus() Call CalcIters End Sub Private Sub IncLength_LostFocus() Call CalcIters End Sub Private Sub IncWidth_LostFocus() Call CalcIters End Sub Private Sub cmdOpen14two_Click() On Error GoTo Err_cmdOpen14two_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "14 two" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_cmdOpen14two_Click: Exit Sub Err_cmdOpen14two_Click: MsgBox Err.Description Resume Exit_cmdOpen14two_Click End Sub Private Sub Addparms(i%, Sizeses!) Dim MainDB As Database, MainSet As Recordset Set MainDB = DBEngine.Workspaces(0).Databases(0) Set MainSet = MainDB.OpenRecordset("Util L X W") ' Create dynaset. BGW! = BegWidth EDW! = EndWidth ICW! = IncWidth BGL! = BegLength EDL! = EndLength ICL! = IncLength If i% = 1 Then BG! = BegWidth ed! = EndWidth IC! = IncWidth Else BG! = BegLength ed! = EndLength IC! = IncLength End If For SS! = BG! To ed! Step IC! If i% = 1 Then SheetWidth! = SS! SheetLength! = Sizeses! Else SheetWidth! = Sizeses! SheetLength! = SS! End If MainSet.AddNew MainSet!SheetL = SheetLength! MainSet!sheetw = SheetWidth! MainSet.Update Next Refresh End Sub Public Sub GetTheBestAnswers() Dim Main2DB As Database, Main2Set As Recordset Set Main2DB = DBEngine.Workspaces(0).Databases(0) Set Main2Set = Main2DB.OpenRecordset("Util L X W") ' Create dynaset. Main2Set.Index = "Primary Key" A = BestSheets If BestSS(1, 0, 0) = 0 Then Exit Sub End If a1$ = "" a2$ = "" ttl# = 0 ttlgw# = 0 a3$ = "" a2$ = Chr$(34) + "Width" + Chr$(34) + ";" + Chr$(34) + "Length" + Chr$(34) + ";" + Chr$(34) + " Price" + Chr$(34) + ";" + Chr$(34) + " Pounds" + Chr$(34) + ";" + Chr$(34) + " Price/Lb" + Chr$(34) + ";" + Chr$(34) + " Actual Wt" + Chr$(34) + ";" For SetNo = 1 To Sheets Key$ = Right$("0000000000" + Trim$(Str$(BestSS(SetNo, 0, A))), 10) GoSub GetTheSheetSize a2$ = a2$ + Chr$(34) + Trim$(Str$(Sheet_Width!)) + Chr$(34) + ";" a2$ = a2$ + Chr$(34) + Trim$(Str$(Sheet_Length!)) + Chr$(34) + ";" a2$ = a2$ + Chr$(34) + lpad$(Format$(BestSS(SetNo, 1, A), "$##,###,##0"), 12) + Chr$(34) + ";" a2$ = a2$ + Chr$(34) + lpad$(Format$(BestSS(SetNo, 2, A), "###,###,##0"), 12) + Chr$(34) + ";" If BestSS(SetNo, 2, 0) = 0 Then ppp = 0 Else ppp = BestSS(SetNo, 1, 0) / BestSS(SetNo, 2, 0) End If a2$ = a2$ + Chr$(34) + lpad$(Format$(ppp, "###0.00000"), 12) + Chr$(34) + ";" ttl# = ttl# + Val(Format(BestSS(SetNo, 1, A), "0")) ttlgw# = ttlgw# + Val(Format(BestSS(SetNo, 2, A), "0")) a3$ = a3$ + Trim$(BestSS(SetNo, 0, A)) + "," Next a3$ = Left$(a3$, Len(a3$) - 1) a2$ = a2$ + Chr$(34) + " " + Chr$(34) + ";" a2$ = a2$ + Chr$(34) + "Total " + Chr$(34) + ";" a2$ = a2$ + Chr$(34) + lpad$(Format$(ttl#, "$##,###,##0"), 12) + Chr$(34) + ";" a2$ = a2$ + Chr$(34) + lpad$(Format$(ttlgw#, "##,###,##0"), 12) + Chr$(34) + ";" a2$ = a2$ + Chr$(34) + lpad$(Format$(ttl# / ttlgw#, "###0.00000"), 12) + Chr$(34) List86.rowSource = a2$ FavoriteSet = a3$ Exit Sub GetTheSheetSize: Main2Set.MoveFirst Main2Set.Seek "=", Key$ If Not (Main2Set.NoMatch) Then Sheet_Width! = Val(Main2Set!sheetw) Sheet_Length! = Val(Main2Set!SheetL) End If Return End Sub Private Sub Command108_Click() On Error GoTo Err_Command108_Click Dim stDocName As String Dim stLinkCriteria As String Command108.Tag = Command108.Caption Command108.Caption = "Processing" DoEvents stDocName = "Util Select picker" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_Command108_Click: Command108.Caption = Command108.Tag Exit Sub Err_Command108_Click: MsgBox Err.Description Resume Exit_Command108_Click End Sub Private Sub Command110_Click() On Error GoTo Err_Command110_Click Dim stDocName As String Command110.Tag = Command110.Caption Command110.Caption = "Processing" DoEvents lblstatus.Caption = "Obtaining Records" DoCmd.SetWarnings (False) stDocName = "Util Make Select 0" DoCmd.OpenQuery stDocName, acNormal, acEdit stDocName = "Util Flag Update" DoCmd.OpenQuery stDocName, acNormal, acEdit stDocName = "Util Make Select 1" DoCmd.OpenQuery stDocName, acNormal, acEdit stDocName = "Util Make Select 2" DoCmd.OpenQuery stDocName, acNormal, acEdit lblstatus.Caption = "Done" Exit_Command110_Click: Command110.Caption = Command110.Tag Exit Sub Err_Command110_Click: MsgBox Err.Description Resume Exit_Command110_Click End Sub Private Sub Command134_Click() On Error GoTo Err_Command134_Click x = Detail.BackColor Detail.BackColor = QBColor(15) DoCmd.PrintOut acPages, 1, 1, acHigh, 1 Detail.BackColor = x Exit_Command134_Click: Exit Sub Err_Command134_Click: MsgBox Err.Description Resume Exit_Command134_Click End Sub ``` ## What it does **Code Description** This VBA code is written for Microsoft Access and appears to be part of a larger application for material utilization and inventory management. The code consists of two main subroutines: `BegLength_LostFocus`, `BegWidth_LostFocus`, and `CalcIters`. ### BegLength_LostFocus and BegWidth_LostFocus Subroutines These two subroutines are event handlers that call the `CalcIters` subroutine when the corresponding form fields (Length or Width) lose focus. The purpose of these subroutines is to calculate iterations for material utilization based on the width and length changes. The `CalcIters` subroutine calculates the total number of iterations (`Iterations`) by multiplying two numbers, `sz1` and `sz2`, which are calculated from the width and length changes. The result is then formatted into a string with zero decimal places. ### cmdButtnCalc_Click Subroutine This subroutine is triggered when a button click event occurs. It performs the following tasks: 1. **Selecting Parts for Material Utilization**: - Opens two databases (`MainDB` and `MainDB2`) and creates recordsets (`MainSet` and `MainSet2`) to access data. - Runs a macro to select parts for material utilization. - Deletes any existing records from the second database. 2. **Purging AS400 Product Number File**: - Moves through the first database's recordset, deleting each record until all records are removed. 3. **Purging AS400 Result File**: - Moves through the second database's recordset, adding new records with updated values from the first database's recordset. 4. **Activating AS400 Program**: - Activates a program on an AS400 system. 5. **Retrieving Results**: - Runs another macro to retrieve results from the AS400 system. - Updates two report fields (`UtilResult1` and `Util Result1`) with the retrieved data. ### Command25_Click Subroutine This subroutine is triggered when a button click event occurs. It appears to be part of a larger calculation for material utilization. The purpose of this subroutine is to calculate sheet sizes based on the width and length changes. The subroutine performs the following tasks: 1. **Initializing Variables**: - Sets various variables (`MainDB`, `MainSet`, `Main2DB`, `Main2Set`) to access data. - Initializes variables for width, length, and density. 2. **Calculating Sheet Sizes**: - Loops through a range of sheet widths and lengths based on the calculated changes. - For each combination of width and length, calculates the total gross weight (`TotalGw!`). - Adds new records to the second database with the calculated values. 3. **Updating Status Message**: - Updates the status message label with a running tally of iterations for material utilization. 4. **Calculating Material Utilization Cost**: - Calculates the cost of material utilization based on the total gross weight. - Exits the subroutine if no density value is entered, or if the first iteration calculation has completed.