# Utilization on Multiple Sheets Analysis generated on: 4/1/2025 4:02:13 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]] | | List158 (Row Source) | | | Combo165 (Row Source) | [[Tables/[Base]] | | Combo168 (Row Source) | [[Tables/[Sheets]] | ## VBA Code ```vba Option Compare Database Dim fromar(10), toar(10), curar(10), CurrSetSize(10), CurrSetGw(10), CurrSetAw(10), Sheets Dim BestSS(10, 3, 6) ' | ' +---------------------> 0 - Sheet Size ' 1 - Price for sheet ' 2 - Pounds used Gw ' 3 - Aw ' Private Sub BasePrice_LostFocus() Call CalcIters End Sub 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 Combo12_Change() A$ = UCase$(Combo12.Column(1)) typ$ = "" If InStr(A$, "S/S") <> 0 Then typ$ = "S/S" If InStr(A$, "C/R") <> 0 Then typ$ = "C/R" If InStr(A$, "COLD ROLL") <> 0 Then typ$ = "C/R" If InStr(A$, "ALUMINIUM") <> 0 Then typ$ = "ALZ" If InStr(A$, "ALZ") <> 0 Then typ$ = "ALZ" TypeofMetal = typ$ GaugeOfType = Left$(Combo12.Column(2), 2) Density = Combo12.Column(3) End Sub Private Sub Command109_Click() On Error GoTo Err_Command109_Click Dim stDocName As String lblstatus.Caption = "Building C1 Records" 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" lblstatus.Caption = "Setting Non Zero Usage Parts to Use" DoCmd.OpenQuery stDocName, acNormal, acEdit UtilResult1.SourceObject = "Util Result1" stDocName = "Util Set all zero usage parts to ignore" lblstatus.Caption = "Setting 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. Dim Prices(4), Rg(4, 2) GoSub InitPricingPerLb 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 TotalAw! = 0 TotalGw! = 0 TotalPrc! = 0 MainSet.MoveFirst Do If Not (MainSet.EOF) Then If MainSet!Flag <> "1" Then FirstValid = 0 BestWt! = 0 BestAw! = 0 BestPrc! = 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) Sheet_W = Sheet_Width: GoSub Pricing Prc! = Gw! * Price If (FirstValid = 0) And (Gw! <> 0) Then BestWt! = Gw! BestAw! = Aw! BestPrc! = Prc! 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) Sheet_W = Sheet_Width: GoSub Pricing Prc! = Gw! * Price If (BestPrc! > Prc!) And (Gw! <> 0) Then BestWt! = Gw! BestAw! = Aw! BestPrc! = Prc! 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) Sheet_W = BestWth!: GoSub Pricing Prc! = Gw! * Price 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 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 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 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) lblstatus.Caption = "Processing" 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" Command109.Enabled = True 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 PurchaseBlank% = ItsAZero(chkPurchaseBlank.Value) 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!ActualWeight = Format$(TotalAw!, "0.00") 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 lblstatus.Caption = "Calculate Gross weight W=" + Format$(BSheet_Width!, "0.00") + " L=" + Format$(BSheet_Length!, "0.00") + " E=" + Format$(Terrs!, "0") Loop CurrentSheetSet = "" a1$ = "" a2$ = "" ttl# = 0 ttlgw# = 0 ttlaw# = 0 a2$ = Chr$(34) + "Width" + Chr$(34) + ";" + Chr$(34) + "Length" + Chr$(34) + ";" + Chr$(34) + " Price" + Chr$(34) + ";" + Chr$(34) + " Gross Wt" + Chr$(34) + ";" + Chr$(34) + " Actual Wt" + Chr$(34) + ";" + Chr$(34) + " Util" + Chr$(34) + ";" + Chr$(34) + " Price/Lb" + 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) + ";" a2$ = a2$ + Chr$(34) + lpad$(Format$(BestSS(SetNo, 3, 0), "###,###,##0"), 12) + Chr$(34) + ";" If BestSS(SetNo, 2, 0) = 0 Then ppp = 0 uuu = 0 Else ppp = BestSS(SetNo, 1, 0) / BestSS(SetNo, 2, 0) uuu = (BestSS(SetNo, 3, 0) / BestSS(SetNo, 2, 0)) * 100 End If a2$ = a2$ + Chr$(34) + lpad$(Format$(uuu, "###,###,##0.0"), 12) + Chr$(34) + ";" 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, 2, 0), "0")) ttlaw# = ttlaw# + Val(Format(BestSS(SetNo, 3, 0), "0")) Next a2$ = a2$ + Chr$(34) + " " + Chr$(34) + ";" a2$ = a2$ + Chr$(34) + "Totals " + 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$(ttlaw#, "###,###,##0"), 12) + Chr$(34) + ";" If ttlgw# <> 0 Then ppx# = ttl# / ttlgw# uux# = (ttlaw# / ttlgw#) * 100 Else ppx# = 0 uux# = 0 End If a2$ = a2$ + Chr$(34) + lpad$(Format$(uux#, "##,###,##0.0"), 12) + Chr$(34) + ";" a2$ = a2$ + Chr$(34) + lpad$(Format$(ppx#, "##,###,##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: TotalAw! = 0 TotalGw! = 0 TotalPrc! = 0 a1$ = "" For SetNo = 1 To Sheets a1$ = a1$ + Str$(curar(SetNo)) CurrSetSize(SetNo) = 0 CurrSetGw(SetNo) = 0 CurrSetAw(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 BestAw! = 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! BestAw! = Aw! BestPrc! = Prc! BestSet = SetNo End If If (BestSet = 0) And (Prc! <> 0) Then BestAw! = Aw! BestWt! = Gw! BestPrc! = Prc! BestSet = SetNo End If End If Next If BestSet = 0 Then goodset = False Exit Do Else TotalAw = BestAw! + TotalAw! TotalGw! = BestWt! + TotalGw! TotalPrc! = BestPrc! + TotalPrc! CurrSetSize(BestSet) = CurrSetSize(BestSet) + BestPrc! CurrSetGw(BestSet) = CurrSetGw(BestSet) + BestWt! CurrSetAw(BestSet) = CurrSetAw(BestSet) + BestAw! 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! BestSS(0, 3, top6) = TotalAw! 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) BestSS(SetNo, 3, top6) = CurrSetAw(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) BestSS(SetNo, 3, top6) = BestSS(SetNo, 3, 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) BestSS(SetNo, 3, worst2best + 1) = CurrSetAw(SetNo) Next BestSS(0, 1, worst2best + 1) = TotalPrc! BestSS(0, 2, worst2best + 1) = TotalGw! BestSS(0, 3, worst2best + 1) = TotalAw! 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) BestSS(SetNo, 3, top6) = BestSS(SetNo, 3, 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) BestSS(SetNo, 3, worst2best) = CurrSetAw(SetNo) Next BestSS(0, 1, worst2best) = TotalPrc! BestSS(0, 2, worst2best) = TotalGw! BestSS(0, 3, worst2best) = TotalAw! 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) BestSS(SetNo, 3, 0) = CurrSetAw(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 TotalAw! = 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! TotalAw! = Aw! + TotalAw! 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 Form_Open(Cancel As Integer) Dim MainDB As Database, MainSet As Recordset, tables As TableDef Set MainDB = DBEngine.Workspaces(0).Databases(0) Set tables = MainDB.TableDefs(0) cnt = MainDB.TableDefs.Count bb$ = "" For i = 0 To cnt - 1 Set tables = MainDB.TableDefs(i) bb$ = bb$ + tables.name + ";" Next List158.rowSource = bb$ 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 ttlaw# = 0 a3$ = "" a2$ = Chr$(34) + "Width" + Chr$(34) + ";" + Chr$(34) + "Length" + Chr$(34) + ";" + Chr$(34) + " Price" + Chr$(34) + ";" + Chr$(34) + " Gross Wt" + Chr$(34) + ";" + Chr$(34) + " Actual Wt" + Chr$(34) + ";" + Chr$(34) + " Util" + Chr$(34) + ";" + Chr$(34) + " Price/Lb" + 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) + ";" a2$ = a2$ + Chr$(34) + lpad$(Format$(BestSS(SetNo, 3, A), "###,###,##0"), 12) + Chr$(34) + ";" If BestSS(SetNo, 2, A) = 0 Then ppp = 0 uuu = 0 Else ppp = BestSS(SetNo, 1, A) / BestSS(SetNo, 2, A) uuu = (BestSS(SetNo, 3, A) / BestSS(SetNo, 2, A)) * 100 End If a2$ = a2$ + Chr$(34) + lpad$(Format$(uuu, "##,###,##0.0"), 12) + Chr$(34) + ";" 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")) ttlaw# = ttlaw# + Val(Format(BestSS(SetNo, 3, 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$(ttlaw#, "##,###,##0"), 12) + Chr$(34) + ";" If ttlgw# <> 0 Then ppx# = ttl# / ttlgw# uux# = (ttlaw# / ttlgw#) * 100 Else ppx# = 0 uux# = 0 End If a2$ = a2$ + Chr$(34) + lpad$(Format$(uux#, "##,###,##0.0"), 12) + Chr$(34) + ";" a2$ = a2$ + Chr$(34) + lpad$(Format$(ppx#, "##,###,##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 Command109.Enabled = False Command133.Enabled = False lblstatus.Caption = "Obtaining Records" Command110.Tag = Command110.Caption Command110.Caption = "Processing" DoEvents 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" Command133.Enabled = True 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 Private Sub NoOfSheets_LostFocus() Call CalcIters End Sub Private Sub Restore_C1_File_Click() tx$ = Trim$(itsaNull$(List158)) If tx$ <> "" Then DoCmd.SetWarnings (False) lblstatus.Caption = "Restoring C1 Records" ' stDocName = "Util Make Select 1" ' DoCmd.OpenQuery stDocName, acNormal, acEdit UtilResult1.SourceObject = "tricks" DoCmd.CopyObject , "Util Selection C1", acTable, tx$ UtilResult1.SourceObject = "Util Result1" lblstatus.Caption = "Done" End If End Sub Private Sub Misc__Click() On Error GoTo Err_Misc__Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "Miscellaneous" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_Misc__Click: Exit Sub Err_Misc__Click: MsgBox Err.Description Resume Exit_Misc__Click End Sub Private Sub cmdFilteredParts1_Click() On Error GoTo Err_cmdFilteredParts1_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "Filtered Parts" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_cmdFilteredParts1_Click: Exit Sub Err_cmdFilteredParts1_Click: MsgBox Err.Description Resume Exit_cmdFilteredParts1_Click End Sub ``` ## What it does **Code Description** ====================== This VBA code is written in Microsoft Excel and appears to be part of a larger application related to material utilization and cost calculation. The code consists of several subroutines that perform the following tasks: ### CalcIters Subroutine ------------------------- This subroutine calculates the number of iterations required for sheet size calculations based on width and length increments. It takes into account any existing width or length increment values. 1. Calculates the absolute differences in width (`sz1`) and length (`sz2`) between the beginning and end points. 2. Divides `sz1` by the absolute value of the current width increment (`IncWidth`) if applicable. 3. Increments `sz1` by 1 to account for the next iteration. 4. Calculates the product of `sz1` and `sz2`. 5. Formats the result as a string with leading zeros. ### cmdButtnCalc_Click Subroutine --------------------------------- This subroutine performs the main calculation process when the command button is clicked. It: 1. Retrieves database connections and recordsets for material utilization data. 2. Purges any existing AS400 product number files from the databases. 3. Purges any existing result files from the second database. 4. Activates an AS400 program using a macro. 5. Runs another macro to retrieve results from the AS400 system. 6. Updates labels with status messages throughout the process. ### Command25_Click Subroutine ------------------------------ This subroutine is used to perform calculations for sheet size, density, and total weight when the command button is clicked again. It: 1. Retrieves database connections and recordsets for material utilization data. 2. Sets up variables for width, length, and increment values based on previous input values. 3. Calculates the total gross weight (`TotalGw!`) by iterating through different sheet sizes. 4. Updates a label with the current status message during the calculation process. 5. Exits the subroutine if no density value is entered. ### Common Variables and Constants --------------------------------- The code uses several variables and constants to store input values, intermediate results, and calculated values, including: * `fromar`, `toar`, `curar`, `CurrSetSize`, `CurrSetGw`, `CurrSetAw`, and `BestSS` arrays to store sheet size data. * `BegWidth`, `EndWidth`, `IncWidth`, `BegLength`, `EndLength`, `ICL`, `Density`, `TotalGw!`, `SheetWidth`, `SheetLength`, `LGrossWt`, `LSheetL`, `LSheetW`, and `Cost` variables to store input values, intermediate results, and calculated values. * `lblstatus` and `Command25` labels to display status messages. ### Macros Used ---------------- The code references several macros, including: * `Material Selections for Utilitzation` * `AS400 Utiliz Results` * `DoEvents` These macros are likely defined elsewhere in the application and perform specific tasks related to material utilization and cost calculation.