Cybernomad
/
PSLine2000Documentation
1
0
Fork 0
Code Issues 1 Pull Requests Packages Projects 1 Releases Wiki Activity
PSLine2000Documentation/Forms/Delete this.md

38 KiB
Raw Blame History

Delete this

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

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 ActiveXCtl24_Click()
End Sub

Private Sub ActiveXCtl24_CommandComplete(ByVal returnValue As Long)
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
    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!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
   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, 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, 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

    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

Private Sub Restore_C1_File_Click()
   tx$ = Trim$(itsaNull$(List158))
   If tx$ <> "" Then

      DoCmd.SetWarnings (False)
      lblstatus.Caption = "Copying 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"
   
   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

What it does

Detailed Description of VBA Code

This VBA code is written for a Microsoft Access application and appears to be part of an inventory management system. The code consists of several procedures that perform various tasks, including calculating material utilization on parts, generating reports, and interacting with an AS400 database.

CalcIters Procedure

This procedure calculates the sheet size based on the entered length and width values. It takes into account any increments (IncWidth and IncLength) and rounds up to the nearest integer using the Abs function.

* Calculates sheet size based on length and width values
* Takes into account any increments (IncWidth and IncLength)

cmdButtnCalc_Click Procedure

This procedure performs a series of actions when the "Calculate Material Utilization" button is clicked:

  1. Create Dynamic Recordsets: It creates dynamic recordsets for two databases, MainDB and MainDB2.
  2. Purge AS400 Product Number File: It deletes all records from the first dynamic recordset.
  3. Purge AS400 Result File: It adds new records to the second dynamic recordset based on a specific condition ( prt = MainSet2!prt).
  4. Activate AS400 Program: It activates an AS400 program using the ActiveXCtl24 object.
  5. Retrieve Results: It runs a macro to retrieve results from the AS400 database and populates two reports, UtilResult1 and Util Result1.
  6. Display Status Message: It updates the status message to indicate that the material utilization calculation is complete.
* Performs series of actions when Calculate Material Utilization button is clicked
* Includes purging AS400 product number file, adding new records to result file, activating program, and retrieving results

Command25_Click Procedure

This procedure performs a similar series of actions as cmdButtnCalc_Click, but with some differences:

  1. Create Dynamic Recordsets: It creates dynamic recordsets for two databases, MainDB and MainDB2.
  2. Set Initial Values: It sets initial values for several variables (BegWidth, EndWidth, etc.) based on user input.
  3. Calculate Material Utilization: It loops through a range of sheet sizes (based on the calculated sheet width and length) and calculates the material utilization using a custom function DoSheetSize.
  4. Populate Matrix Recordset: It adds new records to the second dynamic recordset (Matrix) based on the calculated material utilization.
* Performs series of actions when another button is clicked
* Includes calculating material utilization, looping through sheet sizes, and populating matrix recordset

DoSheetSize Procedure

This procedure is called within Command25_Click to calculate the material utilization for a specific sheet size. It takes into account various parameters (such as density) to determine the total weight of materials used.

* Calculates material utilization for a specific sheet size
* Takes into account various parameters (density, etc.)

Overall, this VBA code appears to be part of an inventory management system that calculates material utilization on parts based on user input and interacts with an AS400 database.