Optimizing Cutting Length

silentwolf

Well-known Member
Joined
May 14, 2008
Messages
1,216
Office Version
  1. 2016
Hi guys,

I have been looking into threads about cutting length here in the forum but not really found exactly what I am after or the issue I am having to get startet with a cutting optimizing tool.

Following situation:
There are different Profiles and different materials which need to be cut to size for several Projects.

On YouTube I found a good video of a similar issue.. but it misses a few things what would be required in my situation.


Stock Items like offcuts:
There are different lenght in Stock like offcuts from previous projects. For example: 3 pieces of 3250 mm of ProfileA, 25 pieces of 2000mm of ProfilB, and 30 pieces of full lenght of 6000mm of ProfileA and so on..

There are several projects to be cut to length :
Project_001:
12 pieces 1250mm ProfileA
10 pieces 1830mm ProfileB

Project_002:
5 pieces 2000mm ProfileA
8 pieces 1200mm ProfileB

And of course there is a cutting blade thikness of 5mm that needs to be taken to account

So is there a way of putting it all into Excel for the Stock Items and Cutting length of each Profile to optimize those cutting length?

Perhaps with Solver or via Code?

Great would be if it could work via VBA and with a GUI ..

Just not sure how to go about take all those variables into account to solve this situation.

Maybe someone could give some ideas on how to go about it?

For the Data I did also try to use Access but I guess for the calculations I would need Excel or Excel Solver or OpenSolver ?


Many thanks

Albert
 
"Got it working no problem!" Well you did better than I did. Anyways, different cut sizes are addressed by the "B" column. If you have different stock lengths, what do you want to use first... shortest or longest? Dave
 
Upvote 0

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Hi silentwolf. I made some adjustments to the code at the link. Thanks to **** KUSLEIKA for his code. Sheet name is "wshCuts". Number of pieces to be cut in A2:A & whatever. Lengths of pieces to be cut in B2:B & whatever. Stock lengths available in C2:C & whatever. Seems to trial OK. The msgbox output can be placed on a sheet if necessary.
HTH. Dave
Code:
Sub ComputeStock()
Dim CutArr() As Double, DetStk() As Variant, Waste As Double, dStk() As Variant
Dim CLastEntry As Integer, CRng As Range, ArCnt As Integer, StkLen() As Variant
Dim Rng As Range, Cnter As Integer, temp As Double, temp2 As Double, rInpStk As Range
Dim lRowCount As Long, i As Long, j As Long, k As Long, rInputCuts As Range, cell As Range
Dim TotStk As Double, TmpStk As Double, rLastEntry As Range, AllZero As Boolean
Dim MinCut As Double, TotCut As Double, sMsg As String, sTtl As String
'number of pieces to be cut in A2:A & whatever
'lengths of pieces to be cut in B2:B & whatever
'stock lengths available in C2:C & whatever
'sheet name is "wshCuts"

'http://dailydoseofexcel.com/archives/author/****-kusleika/page/120/
'POSTED ON SEPTEMBER 12, 2005 BY **** KUSLEIKA
'****Code adjusted for multiple stock lengths

With Sheets("wshCuts")
Set rLastEntry = .Range("A" & .Rows.Count).End(xlUp)
Set rInpStk = .Range("C" & 2)
End With
'Make sure cuts have been entered
If rLastEntry.Address = "$A$1" Then
   Exit Sub
Else
   Set rInputCuts = Sheets("wshCuts").Range("A2", rLastEntry.Address).Resize(, 2)
   lRowCount = rInputCuts.Rows.Count
End If

'Check for non-numeric data and negative numbers
For Each cell In rInputCuts.Cells
   If Not IsNumeric(cell.Value) Then
       MsgBox "Your selected range contains non-numeric data"
       Exit Sub
   End If
   If cell.Value < 0 Then
       MsgBox "All values must be positive"
       Exit Sub
   End If
Next cell

'Make sure stock length was entered
If IsEmpty(rInpStk.Value) Or Not IsNumeric(rInpStk.Value) Or rInpStk.Value <= 0 Then
   MsgBox "Stock length must be a positive number"
   Exit Sub
Else ' set range of stock lengths
   With Sheets("wshCuts")
   CLastEntry = .Range("C" & .Rows.Count).End(xlUp).Row
   Set CRng = .Range(.Cells(2, "C"), .Cells(CLastEntry, "C"))
   End With
End If

'load rng to dStk stock array of board lengths
For Each Rng In CRng
Cnter = Cnter + 1
ReDim Preserve dStk(Cnter)
dStk(Cnter - 1) = Rng.Value
Next Rng

'Sort descending stock length array
For i = 0 To UBound(dStk) - 1
   For j = i + 1 To UBound(dStk)
       If dStk(i) < dStk(j) Then
           temp = dStk(i) 'small
           temp2 = dStk(j) 'large
           dStk(i) = temp2
           dStk(j) = temp
       End If
   Next j
Next i

ReDim CutArr(lRowCount - 1, 1)
'Fill array with cuts
For i = 0 To UBound(CutArr, 1)
   For j = 0 To UBound(CutArr, 2)
       CutArr(i, j) = rInputCuts.Cells(i + 1, j + 1)
   Next j
Next i

'Sort array descending on cut length
For i = 0 To UBound(CutArr, 1) - 1
   For j = i + 1 To UBound(CutArr, 1)
       If CutArr(i, 1) < CutArr(j, 1) Then
           temp = CutArr(j, 0)
           temp2 = CutArr(j, 1)
           CutArr(j, 0) = CutArr(i, 0)
           CutArr(j, 1) = CutArr(i, 1)
           CutArr(i, 0) = temp
           CutArr(i, 1) = temp2
       End If
   Next j
Next i

'Make sure all cuts can be made with stock length
If CutArr(0, 1) > dStk(LBound(dStk)) Then
   MsgBox "At least one cut is greater than the stock length."
   Exit Sub
End If

'Initialize variables
MinCut = CutArr(UBound(CutArr), 1)

'Get ArCnt for stock length array
For ArCnt = UBound(dStk) To LBound(dStk) Step -1
If MinCut <= dStk(ArCnt) Then
Exit For
End If
Next ArCnt

'StkLen array stores stock array outputs
ReDim StkLen(1)
StkLen(0) = dStk(ArCnt)

TotCut = 1  'set > 0 to start loop, TotCut is
           'recalced within loop
TmpStk = 0
i = 0
k = 0
'TotCut is sum of first dimensions in array
Do While TotCut > 0
   'MinCut is smallest 2nd dimension where 1st
   'dimension is > 0
   Do While TmpStk >= MinCut
       If CutArr(i, 1) <= TmpStk And CutArr(i, 0) > 0 Then
           'Reduce current stock length by cut length
           TmpStk = TmpStk - CutArr(i, 1)
           'Reduce number of current cut by 1
           CutArr(i, 0) = CutArr(i, 0) - 1
           'Store current cut length
           ReDim Preserve DetStk(1, k)
           DetStk(0, k) = TotStk
           DetStk(1, k) = CutArr(i, 1)
           'store stock length
           ReDim Preserve StkLen(k)
           StkLen(k) = dStk(ArCnt)
           k = k + 1
       Else
           'Move to next cut length
       i = i + 1
       End If
      
       'Reset MinCut
       AllZero = True
       For j = LBound(CutArr) To UBound(CutArr)
           If CutArr(j, 0) > 0 Then
               MinCut = CutArr(j, 1)
               AllZero = False
           End If
       Next j
       'If there are no cut pieces remaining, get out
       If AllZero Then
           Exit Do
       End If
   Loop
  
   'if waste exists
   If TmpStk <> 0 Then
   Waste = Waste + TmpStk
       ReDim Preserve DetStk(1, k)
       DetStk(0, k) = TotStk
       DetStk(1, k) = TmpStk & " Waste"
       ReDim Preserve StkLen(k)
       StkLen(k) = dStk(ArCnt)
       k = k + 1
   End If
   
   'Get ArCnt for stock length array
   For ArCnt = UBound(dStk) To LBound(dStk) Step -1
   If MinCut <= dStk(ArCnt) Then
   Exit For
   End If
   Next ArCnt
   
   'Reset TmpStk and add one to TotStk
   TmpStk = dStk(ArCnt)
   TotStk = TotStk + 1
  
   'Reset i to row of largest 2nd dimension whose
   '1st dimension Is Not zero
   For j = UBound(CutArr) To LBound(CutArr) Step -1
       If CutArr(j, 0) <> 0 Then
           i = j
       End If
   Next j
  
   'Reset TotCut to sum of all 1st
   'dimensions
   TotCut = 0
   For j = LBound(CutArr) To UBound(CutArr)
       TotCut = TotCut + CutArr(j, 0)
   Next j
Loop

'Output totals to a message box
sTtl = "Total Boards = " & TotStk - 1
sMsg = "Board No." & vbTab & "Stock Length" & vbTab & "Cut Length" & vbCrLf
For k = LBound(DetStk, 2) To UBound(DetStk, 2)
  sMsg = sMsg & DetStk(0, k) & vbTab & vbTab & StkLen(k) & vbTab & vbTab _
       & DetStk(1, k) & vbCrLf
Next k
MsgBox sMsg & vbCrLf & "Total Waste: " & Waste, vbOKOnly, sTtl
End Sub
 
Upvote 0
Hi Dave,

many thanks to your code! I will look into it and let you know how I went with it!

Many thanks!
 
Upvote 0
Hi again silentwolf. I kicked this around some more. The previous code assumed an unlimited supply of your stock lengths. Being a bit of a handyman, I thought it would be a fairly useful bit of code, so I thought I'd blow off some more webspace. I added the number of pieces of stock lengths to the code in column D (D2 to whatever) which was part of your original request. You still can't mix your board types (ie. ProfileA with ProfileB). For your ProfileA example, it outputs 6 boards cut with 2750 waste to achieve your number of pieces at your cut lengths with available stock size and stock pieces. I'm not sure that it optimizes your stock utilization as it always starts with outputting your shortest cut sizes first. The code will also warn you if you don't have enough stock available to make the number of cuts and cut lengths. As for saw blade thickness, I would add the amount to your cut length. The sheet set up is as previously indicated with the addition of the number of stock pieces in D2 to D & whatever. HTH. Dave
Code:
Sub ComputeStock()
Dim CutArr() As Double, DetStk() As Variant, Waste As Double, dStk() As Variant, pStk() As Variant
Dim CLastEntry As Integer, CRng As Range, ArCnt As Integer, StkLen() As Variant, DRng As Range
Dim Rng As Range, Cnter As Integer, temp As Double, temp2 As Double, rInpStk As Range
Dim lRowCount As Long, i As Long, j As Long, k As Long, rInputCuts As Range, cell As Range
Dim TotStk As Double, TmpStk As Double, rLastEntry As Range, AllZero As Boolean
Dim MinCut As Double, TotCut As Double, sMsg As String, sTtl As String
'number of pieces to be cut in A2:A & whatever
'lengths of pieces to be cut in B2:B & whatever
'stock lengths available in C2:C & whatever
'number of pieces of stock lengths in D2:D & whatever
'sheet name is "wshCuts"

'http://dailydoseofexcel.com/archives/author/****-kusleika/page/120/
'POSTED ON SEPTEMBER 12, 2005 BY **** KUSLEIKA
'****Code adjusted for multiple stock lengths and varied stock pieces

With Sheets("wshCuts")
Set rLastEntry = .Range("A" & .Rows.Count).End(xlUp)
Set rInpStk = .Range("C" & 2)
End With
'Make sure cuts have been entered
If rLastEntry.Address = "$A$1" Then
   Exit Sub
Else
   Set rInputCuts = Sheets("wshCuts").Range("A2", rLastEntry.Address).Resize(, 2)
   lRowCount = rInputCuts.Rows.Count
End If

'Check for non-numeric data and negative numbers
For Each cell In rInputCuts.Cells
   If Not IsNumeric(cell.Value) Then
       MsgBox "Your selected range contains non-numeric data"
       Exit Sub
   End If
   If cell.Value < 0 Then
       MsgBox "All values must be positive"
       Exit Sub
   End If
Next cell

'Make sure stock length was entered
If IsEmpty(rInpStk.Value) Or Not IsNumeric(rInpStk.Value) Or rInpStk.Value <= 0 Then
   MsgBox "Stock length must be a positive number"
   Exit Sub
Else ' set range of stock lengths
   With Sheets("wshCuts")
   CLastEntry = .Range("C" & .Rows.Count).End(xlUp).Row
   Set CRng = .Range(.Cells(2, "C"), .Cells(CLastEntry, "C"))
   Set DRng = .Range(.Cells(2, "D"), .Cells(CLastEntry, "D"))
   End With
End If

'load rng to dStk stock array of board lengths
For Each Rng In CRng
Cnter = Cnter + 1
ReDim Preserve dStk(Cnter)
dStk(Cnter - 1) = Rng.Value
Next Rng

'load rng to pStk stock piece array
Cnter = 0
For Each Rng In DRng
Cnter = Cnter + 1
ReDim Preserve pStk(Cnter)
pStk(Cnter - 1) = Rng.Value
Next Rng

'Sort descending stock length & stock piece arrays
For i = 0 To UBound(dStk) - 1
   For j = i + 1 To UBound(dStk)
       If dStk(i) < dStk(j) Then
           temp = dStk(i) 'small
           temp2 = dStk(j) 'large
           temp3 = pStk(i) 'small
           temp4 = pStk(j) 'large
           dStk(i) = temp2
           dStk(j) = temp
           pStk(i) = temp4
           pStk(j) = temp3
       End If
   Next j
Next i

ReDim CutArr(lRowCount - 1, 1)
'Fill array with cuts
For i = 0 To UBound(CutArr, 1)
   For j = 0 To UBound(CutArr, 2)
       CutArr(i, j) = rInputCuts.Cells(i + 1, j + 1)
   Next j
Next i

'Sort array descending on cut length
For i = 0 To UBound(CutArr, 1) - 1
   For j = i + 1 To UBound(CutArr, 1)
       If CutArr(i, 1) < CutArr(j, 1) Then
           temp = CutArr(j, 0)
           temp2 = CutArr(j, 1)
           CutArr(j, 0) = CutArr(i, 0)
           CutArr(j, 1) = CutArr(i, 1)
           CutArr(i, 0) = temp
           CutArr(i, 1) = temp2
       End If
   Next j
Next i

'Make sure all cuts can be made with stock length
If CutArr(0, 1) > dStk(LBound(dStk)) Then
   MsgBox "At least one cut is greater than the stock length."
   Exit Sub
End If

'Initialize variables
MinCut = CutArr(UBound(CutArr), 1)

'Get ArCnt for stock length array
For ArCnt = UBound(dStk) To LBound(dStk) Step -1
If MinCut <= dStk(ArCnt) Then
Exit For
End If
Next ArCnt

'StkLen array stores stock array outputs
ReDim StkLen(1)
StkLen(0) = dStk(ArCnt)

TotCut = 1  'set > 0 to start loop, TotCut is
           'recalced within loop
TmpStk = 0
i = 0
k = 0
'TotCut is sum of first dimensions in array
Do While TotCut > 0
   'MinCut is smallest 2nd dimension where 1st
   'dimension is > 0
   Do While TmpStk >= MinCut
       If CutArr(i, 1) <= TmpStk And CutArr(i, 0) > 0 Then
           'Reduce current stock length by cut length
           TmpStk = TmpStk - CutArr(i, 1)
           'Reduce number of current cut by 1
           CutArr(i, 0) = CutArr(i, 0) - 1
           'Store current cut length
           ReDim Preserve DetStk(1, k)
           DetStk(0, k) = TotStk
           DetStk(1, k) = CutArr(i, 1)
           'store stock length
           ReDim Preserve StkLen(k)
           StkLen(k) = dStk(ArCnt)
           k = k + 1
       Else
           'Move to next cut length
       i = i + 1
       End If
      
       'Reset MinCut
       AllZero = True
       For j = LBound(CutArr) To UBound(CutArr)
           If CutArr(j, 0) > 0 Then
               MinCut = CutArr(j, 1)
               AllZero = False
           End If
       Next j
       'If there are no cut pieces remaining, get out
       If AllZero Then
           Exit Do
       End If
   Loop
  
   'if waste exists
   If TmpStk <> 0 Then
   Waste = Waste + TmpStk
       ReDim Preserve DetStk(1, k)
       DetStk(0, k) = TotStk
       DetStk(1, k) = TmpStk & " Waste"
       ReDim Preserve StkLen(k)
       StkLen(k) = dStk(ArCnt)
       k = k + 1
   End If
   
   'if out of stock move to next stock length and remove from stock array
   If pStk(ArCnt) = 0 Then
       ArCnt = ArCnt - 1
       ReDim Preserve dStk(UBound(dStk) - 1)
   If ArCnt < 0 Then
   MsgBox "Not enough Stock to make all Pieces at Cut Lengths!!!"
   Exit Sub
   End If
   
   'Get ArCnt for stock length array
   For ArCnt = UBound(dStk) - 1 To LBound(dStk) Step -1
   If MinCut <= dStk(ArCnt) Then
   Exit For
   End If
   Next ArCnt
   End If
   
   'reduce stock amt by 1, reset TmpStk, add one to TotStk
   pStk(ArCnt) = pStk(ArCnt) - 1
   TmpStk = dStk(ArCnt)
   TotStk = TotStk + 1
  
   'Reset i to row of largest 2nd dimension whose
   '1st dimension Is Not zero
   For j = UBound(CutArr) To LBound(CutArr) Step -1
       If CutArr(j, 0) <> 0 Then
           i = j
       End If
   Next j
  
   'Reset TotCut to sum of all 1st
   'dimensions
   TotCut = 0
   For j = LBound(CutArr) To UBound(CutArr)
       TotCut = TotCut + CutArr(j, 0)
   Next j
Loop

'Output totals to a message box
sTtl = "Total Boards = " & TotStk - 1
sMsg = "Board No." & vbTab & "Stock Length" & vbTab & "Cut Length" & vbCrLf
For k = LBound(DetStk, 2) To UBound(DetStk, 2)
  sMsg = sMsg & DetStk(0, k) & vbTab & vbTab & StkLen(k) & vbTab & vbTab _
       & DetStk(1, k) & vbCrLf
Next k
MsgBox sMsg & vbCrLf & "Total Waste: " & Waste, vbOKOnly, sTtl
End Sub
ps. Again, thanks to "D"I"C"K" KUSLEIKA for his major contribution to this code.
 
Upvote 0
Whoops! Maybe hold off on the testing. I ran into a glitch that needed the task manager to fix the problem. I'll update the code and re-post. Dave
 
Upvote 0
Well maybe third time is a charm. Seem to have fixed the glitch and optimized the cutting as well. The code now starts with using up the shortest available stock and progresses to using the largest stock available. Same sheet set up as the most recent post. Dave
Code:
Sub ComputeStock()
Dim CutArr() As Double, DetStk() As Variant, Waste As Double, dStk() As Variant, pStk() As Variant
Dim CLastEntry As Integer, CRng As Range, ArCnt As Integer, StkLen() As Variant, DRng As Range
Dim Rng As Range, Cnter As Integer, Temp As Double, Temp2 As Double, rInpStk As Range
Dim lRowCount As Long, i As Long, j As Long, k As Long, rInputCuts As Range, cell As Range
Dim TotStk As Double, TmpStk As Double, rLastEntry As Range, AllZero As Boolean
Dim MinCut As Double, TotCut As Double, sMsg As String, sTtl As String, FlagIt As Boolean
Dim Temp3 As Double, Temp4 As Double, t As Integer, TempArr() As Variant, TempArr2() As Variant
'number of pieces to be cut in A2:A & whatever
'lengths of pieces to be cut in B2:B & whatever
'stock lengths available in C2:C & whatever
'number of pieces of stock lengths in D2:D & whatever
'sheet name is "wshCuts"

'http://dailydoseofexcel.com/archives/author/****-kusleika/page/120/
'POSTED ON SEPTEMBER 12, 2005 BY **** KUSLEIKA
'****Code adjusted for multiple stock lengths and varied stock pieces

With Sheets("wshCuts")
Set rLastEntry = .Range("A" & .Rows.Count).End(xlUp)
Set rInpStk = .Range("C" & 2)
End With
'Make sure cuts have been entered
If rLastEntry.Address = "$A$1" Then
   Exit Sub
Else
   Set rInputCuts = Sheets("wshCuts").Range("A2", rLastEntry.Address).Resize(, 2)
   lRowCount = rInputCuts.Rows.Count
End If

'Check for non-numeric data and negative numbers
For Each cell In rInputCuts.Cells
   If Not IsNumeric(cell.Value) Then
       MsgBox "Your selected range contains non-numeric data"
       Exit Sub
   End If
   If cell.Value < 0 Then
       MsgBox "All values must be positive"
       Exit Sub
   End If
Next cell

'Make sure stock length was entered
If IsEmpty(rInpStk.Value) Or Not IsNumeric(rInpStk.Value) Or rInpStk.Value <= 0 Then
   MsgBox "Stock length must be a positive number"
   Exit Sub
Else ' set range of stock lengths
   With Sheets("wshCuts")
   CLastEntry = .Range("C" & .Rows.Count).End(xlUp).Row
   Set CRng = .Range(.Cells(2, "C"), .Cells(CLastEntry, "C"))
   Set DRng = .Range(.Cells(2, "D"), .Cells(CLastEntry, "D"))
   End With
End If

'load rng to dStk stock array of board lengths
For Each Rng In CRng
Cnter = Cnter + 1
ReDim Preserve dStk(Cnter)
dStk(Cnter - 1) = Rng.Value
Next Rng

'load rng to pStk stock piece array
Cnter = 0
For Each Rng In DRng
Cnter = Cnter + 1
ReDim Preserve pStk(Cnter)
pStk(Cnter - 1) = Rng.Value
Next Rng

'Sort descending stock length & stock piece arrays
For i = 0 To UBound(dStk) - 1
   For j = i + 1 To UBound(dStk)
       If dStk(i) < dStk(j) Then
           Temp = dStk(i) 'small
           Temp2 = dStk(j) 'large
           Temp3 = pStk(i) 'small
           Temp4 = pStk(j) 'large
           dStk(i) = Temp2
           dStk(j) = Temp
           pStk(i) = Temp4
           pStk(j) = Temp3
       End If
   Next j
Next i

'Fill array with cuts
ReDim CutArr(lRowCount - 1, 1)
For i = 0 To UBound(CutArr, 1)
   For j = 0 To UBound(CutArr, 2)
       CutArr(i, j) = rInputCuts.Cells(i + 1, j + 1)
   Next j
Next i

'Sort Cut array descending on cut length
For i = 0 To UBound(CutArr, 1) - 1
   For j = i + 1 To UBound(CutArr, 1)
       If CutArr(i, 1) < CutArr(j, 1) Then
           Temp = CutArr(j, 0)
           Temp2 = CutArr(j, 1)
           CutArr(j, 0) = CutArr(i, 0)
           CutArr(j, 1) = CutArr(i, 1)
           CutArr(i, 0) = Temp
           CutArr(i, 1) = Temp2
       End If
   Next j
Next i

'Make sure all cuts can be made with stock length
If CutArr(0, 1) > dStk(LBound(dStk)) Then
   MsgBox "At least one cut is greater than the stock length."
   Exit Sub
End If

'Initialize variables
MinCut = CutArr(UBound(CutArr), 1)

'Get ArCnt for stock length array
'remove stock lengths that are too short for cut lengths from array
For ArCnt = UBound(dStk) - 1 To LBound(dStk) Step -1
If MinCut <= dStk(ArCnt) Then
Exit For
Else
ReDim Preserve dStk(UBound(dStk) - 1)
ReDim Preserve pStk(UBound(pStk) - 1)
End If
Next ArCnt

'StkLen array stores stock array outputs
ReDim StkLen(1)
StkLen(0) = dStk(ArCnt)

TotCut = 1  'set > 0 to start loop, TotCut is
           'recalced within loop
TmpStk = 0
i = 0
k = 0
'TotCut is sum of first dimensions in array
Do While TotCut > 0
   'MinCut is smallest 2nd dimension where 1st
   'dimension is > 0
   Do While TmpStk >= MinCut
       If CutArr(i, 1) <= TmpStk And CutArr(i, 0) > 0 Then
           'Reduce current stock length by cut length
           TmpStk = TmpStk - CutArr(i, 1)
           'Reduce number of current cut by 1
           CutArr(i, 0) = CutArr(i, 0) - 1
           'Store current cut length
           ReDim Preserve DetStk(1, k)
           DetStk(0, k) = TotStk
           DetStk(1, k) = CutArr(i, 1)
           'store stock length
           ReDim Preserve StkLen(k)
           StkLen(k) = dStk(ArCnt)
           k = k + 1
       Else
           'Move to next cut length
       i = i + 1
       End If
      
       'Reset MinCut
       AllZero = True
       For j = LBound(CutArr) To UBound(CutArr)
           If CutArr(j, 0) > 0 Then
               MinCut = CutArr(j, 1)
               AllZero = False
           End If
       Next j
       'If there are no cut pieces remaining, get out
       If AllZero Then
           Exit Do
       End If
   Loop
   
   FlagIt = False
   'if waste exists
   If TmpStk <> 0 Then
   'check if waste is large enough for another cut length
   If TmpStk <> dStk(ArCnt) Then
   Waste = Waste + TmpStk
       ReDim Preserve DetStk(1, k)
       DetStk(0, k) = TotStk
       DetStk(1, k) = TmpStk & " Waste"
       ReDim Preserve StkLen(k)
       StkLen(k) = dStk(ArCnt)
       k = k + 1
   Else
   'use stock piece for another cut
   FlagIt = True
   End If
   End If
   
   'if out of stock move to next stock length and remove item from stock array
   If pStk(ArCnt) = 0 Then
   ReDim TempArr2(UBound(dStk) - 1)
   ReDim TempArr(UBound(pStk) - 1)
   For t = LBound(dStk) To UBound(dStk) - 1
   If t <> ArCnt Then
   TempArr(t) = dStk(t)
   TempArr2(t) = pStk(t)
   End If
   Next t
   dStk = TempArr
   pStk = TempArr2
 
   ArCnt = ArCnt - 1
    
   If ArCnt < 0 Then
   MsgBox "Not enough Stock to make all Pieces at Cut Lengths!!!"
   Exit Sub
   End If
   End If

   'Get ArCnt for stock length array
   For ArCnt = UBound(dStk) - 1 To LBound(dStk) Step -1
   If MinCut <= dStk(ArCnt) Then
   Exit For
   End If
   Next ArCnt
   
   'reduce stock amt by 1, reset TmpStk
   'add one to TotStk only if stock piece not being used for another cut length
   pStk(ArCnt) = pStk(ArCnt) - 1
   TmpStk = dStk(ArCnt)
   If Not FlagIt Then
   TotStk = TotStk + 1
   End If
   
   'Reset i to row of largest 2nd dimension whose
   '1st dimension Is Not zero
   For j = UBound(CutArr) To LBound(CutArr) Step -1
       If CutArr(j, 0) <> 0 Then
           i = j
       End If
   Next j
  
   'Reset TotCut to sum of all 1st
   'dimensions
   TotCut = 0
   For j = LBound(CutArr) To UBound(CutArr)
       TotCut = TotCut + CutArr(j, 0)
   Next j
Loop

'Output totals to a message box
sTtl = "Total Boards = " & TotStk - 1
sMsg = "Board No." & vbTab & "Stock Length" & vbTab & "Cut Length" & vbCrLf
For k = LBound(DetStk, 2) To UBound(DetStk, 2)
  sMsg = sMsg & DetStk(0, k) & vbTab & vbTab & StkLen(k) & vbTab & vbTab _
       & DetStk(1, k) & vbCrLf
Next k
MsgBox sMsg & vbCrLf & "Total Waste: " & Waste, vbOKOnly, sTtl
End Sub
 
Upvote 0
One last code glitch to fix (hopefully), Dave
Replace this line...
Code:
'if out of stock move to next stock length and remove item from stock array
  If pStk(ArCnt) = 0 Then
with...
Code:
'if out of stock move to next stock length and remove item from stock array
   If pStk(ArCnt) = 0 And TotCut <> 1 Then '*********Changed this line of code!!!
 
Upvote 0

Forum statistics

Threads
1,216,500
Messages
6,131,016
Members
449,615
Latest member
Nic0la

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top