# xyz
---
## Record Source
- *None*
## Controls
| Control Name | Reference |
|--------------|-----------|
| List86 (Row Source) |  |
## VBA Code
```vba
Option Compare Database
   Dim fromar(10), toar(10), curar(10), CurrSetSize(10), Sheets
   Dim BestSS(10, 3, 6)
'                 |
'                 +---------------------> 0 - Sheet Size
'                                         1 - Pounds used
'                                         2 - Price for sheet
'


Private Sub ActiveXCtl24_Click()
End Sub

Private Sub ActiveXCtl24_CommandComplete(ByVal returnValue As Long)
End Sub

Private Sub ActiveXCtl24_Updated(code As Integer)

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 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.
   
   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
   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

'
'  Count up the number of iterations to go through
'
   NoOfIters% = 0
   lblstatus.Caption = "Numbering Iterations"
   Main2Set.MoveFirst
   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
   Loop
   
   If NoOfIters% < Sheets Then
      MsgBox ("Not Enough Iterations")
      Command79.Enabled = True
      Exit Sub
   End If
   Iterations = NoOfIters%
   
   GoSub Init_Iterations
   FirstIter = True
          
   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
          
   GoSub CalcGWforSet
   


   CurrentSheetSet = ""
   a1$ = ""
   a2$ = ""
   ttl# = 0
   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) + ";"
      ttl# = ttl# + 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)
   BestSheetSet = a1$
   List86.rowSource = a2$

   Command79.Enabled = True

Exit Sub

CalcGWforSet:
   TotalGw! = 0
         
   a1$ = ""
   For SetNo = 1 To Sheets
      a1$ = a1$ + Str$(curar(SetNo))
      CurrSetSize(SetNo) = 0
   Next
   CurrentSheetSet = a1$
   MainSet.MoveFirst
   Do
      If Not (MainSet.EOF) Then
         
         BestWt! = 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)
            If SetNo = 1 Then
               BestWt! = Gw!
               BestSet = SetNo
            Else
               If BestWt! > Gw! Then
                  BestWt! = Gw!
                  BestSet = SetNo
               End If
            End If
         Next
         TotalGw! = BestWt! + TotalGw!
         CurrSetSize(BestSet) = CurrSetSize(BestSet) + BestWt!
      
         DoEvents
      Else
         DoEvents
         Exit Do
      End If
      MainSet.MoveNext
   Loop
      
   If (TotalGw! < bestsetgw!) Or FirstIter Then
      FirstIter = False
      bestsetgw! = TotalGw!
      LGrossWt = TotalGw!
      BestSheetSet = CurrentSheetSet
      For SetNo = 1 To Sheets
         BestSS(SetNo, 0, 0) = curar(SetNo)
         BestSS(SetNo, 1, 0) = CurrSetSize(SetNo)
         For top6 = 6 To 1 Step -1
            BestSS(SetNo, 0, top6) = BestSS(SetNo, 0, top6 - 1)
            BestSS(SetNo, 1, top6) = BestSS(SetNo, 1, top6 - 1)
         Next
      Next
   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

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
   
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
   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) + ";"
      ttl# = ttl# + Val(Format(BestSS(SetNo, 1, A), "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)
   List86.rowSource = a2$
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
```
## What it does
**ActiveX Control 24 Calculation and Material Utilization Code**
===========================================================

This VBA code is used to calculate material utilization for a set of parts in an Excel worksheet. It consists of several subroutines that perform the following tasks:

### Initialization and Event Handling

The code initializes variables and sets up event handlers for buttons and macros.

*   `ActiveXCtl24_Click()`: Empty subroutine for handling button clicks.
*   `ActiveXCtl24_CommandComplete()` and `ActiveXCtl24_Updated(code As Integer)`: Empty subroutines for handling command completion and updates.
*   `BegLength_LostFocus()` and `BegWidth_LostFocus()`: Subroutines called when the length and width fields lose focus, which calls `CalcIters()` to update calculations.

### Calculation of Sheet Size and Material Utilization

The code uses several variables to store sheet size values:

*   `sz1` and `sz2`: Calculated values for sheet size based on width and length changes.
*   `Iterations`: Stores the number of iterations performed during calculations, formatted as a string (e.g., "123").

The `CalcIters()` subroutine calculates these values based on input field changes:

```markdown
Private Sub CalcIters()
    sz1 = Abs(EndWidth - BegWidth)
    If IncWidth \u003c\u003e 0 Then
        sz1 = sz1 / Abs(IncWidth)
    End If
    sz1 = sz1 + 1
    sz2 = Abs(EndLength - BegLength)
    If IncLength \u003c\u003e 0 Then
        sz2 = sz2 / Abs(IncLength)
    End If
    sz2 = sz2 + 1
    sz1 = sz1 * sz2
    Iterations = Format$(sz1, "0")
```

### Material Utilization Calculation and Macro Execution

The `cmdButtnCalc_Click()` subroutine performs the following steps:

*   Retrieves data from two databases (`MainDB` and `MainDB2`) using dynamic recordsets.
*   Purges existing records in the first database.
*   Adds new records to the second database, including parts with calculated material utilization values.
*   Activates an AS400 program using the `ActiveXCtl24.DoClick()` method.

```markdown
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)
    
    ' ... (parsing and modifying records in MainDB and MainDB2 databases) ...
    
    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 = "Done"
```

### Material Matrix Calculation and Display

The `Command25_Click()` subroutine:

*   Retrieves data from two databases (`MainDB` and `Main2DB`) using dynamic recordsets.
*   Iterates over sheet size values, adding new records to the second database with calculated material utilization values.

```markdown
Private Sub Command25_Click()
    ' ... (parsing and modifying records in MainDB and Main2DB databases) ...
    
    Dim TotalGw! As Double
    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 \u003e TotalGw!) Then
                LGrossWt = TotalGw!
                LSheetL = SheetLength
                LSheetW = SheetWidth
                First = False
            End If
        Next
    Next
    
    Cost = 0
End Sub

DoSheetSize:
    ' ... (calculate material utilization values based on current sheet size) ...
```