Cutting Stock Lengths
Here's a program I wrote some time ago to determine how much stock (such as lumber) of a particular length you would need to get a certain number of cut stock. It sorts the cuts from longest to shortest and uses up the stock in that order. That may not be the most efficient use of stock, but I can't think of a better way.
Sub ComputeStock()
Dim CutArr() As Double, DetStk() As Double
Dim R As Long
Dim lRowCount As Long
Dim i As Long, j As Long, k As Long
Dim temp As Double, temp2 As Double
Dim TotStk As Double, TmpStk As Double
Dim MinCut As Double, TotCut As Double
Dim dStk As Double
Dim rInpStk As Range
Dim rInputCuts As Range
Dim rLastEntry As Range
Dim AllZero As Boolean
Dim sMsg As String, sTtl As String
Dim cell As Range
Set rLastEntry = wshCuts.Range("A" & wshCuts.Rows.Count).End(xlUp)
Set rInpStk = wshCuts.Range("InpStock")
'Make sure cuts have been entered
If rLastEntry.Address = "$A$1" Then
Exit Sub
Else
Set rInputCuts = 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 lenght 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
dStk = rInpStk.Value
End If
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 lenght
If CutArr(0, 1)> dStk Then
MsgBox "At least one cut is greater than the stock length."
Exit Sub
End If
'Initialize variables
MinCut = CutArr(UBound(CutArr), 1)
TmpStk = dStk
TotCut = 1 'set> 0 to start loop, TotCut is
'recalced within loop
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 + 1
DetStk(1, k) = CutArr(i, 1)
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
'Reset TmpStk and add one to TotStk
TmpStk = dStk
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 stock at " & dStk & " = " & TotStk
sMsg = "Board No." & vbTab & "Cut Lenght" & vbCrLf
For k = LBound(DetStk, 2) To UBound(DetStk, 2)
sMsg = sMsg & DetStk(0, k) & vbTab & vbTab _
& DetStk(1, k) & vbCrLf
Next k
MsgBox sMsg, vbOKOnly, sTtl
Dim CutArr() As Double, DetStk() As Double
Dim R As Long
Dim lRowCount As Long
Dim i As Long, j As Long, k As Long
Dim temp As Double, temp2 As Double
Dim TotStk As Double, TmpStk As Double
Dim MinCut As Double, TotCut As Double
Dim dStk As Double
Dim rInpStk As Range
Dim rInputCuts As Range
Dim rLastEntry As Range
Dim AllZero As Boolean
Dim sMsg As String, sTtl As String
Dim cell As Range
Set rLastEntry = wshCuts.Range("A" & wshCuts.Rows.Count).End(xlUp)
Set rInpStk = wshCuts.Range("InpStock")
'Make sure cuts have been entered
If rLastEntry.Address = "$A$1" Then
Exit Sub
Else
Set rInputCuts = 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 lenght 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
dStk = rInpStk.Value
End If
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 lenght
If CutArr(0, 1)> dStk Then
MsgBox "At least one cut is greater than the stock length."
Exit Sub
End If
'Initialize variables
MinCut = CutArr(UBound(CutArr), 1)
TmpStk = dStk
TotCut = 1 'set> 0 to start loop, TotCut is
'recalced within loop
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 + 1
DetStk(1, k) = CutArr(i, 1)
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
'Reset TmpStk and add one to TotStk
TmpStk = dStk
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 stock at " & dStk & " = " & TotStk
sMsg = "Board No." & vbTab & "Cut Lenght" & vbCrLf
For k = LBound(DetStk, 2) To UBound(DetStk, 2)
sMsg = sMsg & DetStk(0, k) & vbTab & vbTab _
& DetStk(1, k) & vbCrLf
Next k
MsgBox sMsg, vbOKOnly, sTtl
End Sub
I should really put the output on a sheet instead of a message box so it could be printed. I started to do something similar for square feet instead of linear feet (like plywood instead of 2x4s), but it was way too hard. You can download BoardFeet.zip.
Tim:
Dick, this could be very useful, but what about the amount of wood you lose with each cut? Needs to have a place to put how wide the saw blade is to account for this in each cut you make on a board. As you said it would be better to have the results put on a sheet and maybe even the "waste" that is left in each board, just a thought
13 September 2005, 12:35 pmDick Kusleika:
The width of a saw blade? What are you making, Scandinavian furniture? It might be good to have a generic waste factor in there. The user could enter either a percentage or a hard measurement and that could be added to each cut, or rather subtracted from the remaining stock after each cut.
13 September 2005, 12:56 pmI thought about tracking the waste, but never got around to doing it.
Tim:
No am not making Scandinavian furniture but with a 1/8" saw blade and if you have 36" stock and want three 12" boards you would end up with two 12" and one 11 3/4". If you are making anything, except maybe "rough" framing a house that is a big deal. And of course the longer the stock and the more cuts you make or a wider saw blade, this becomes more of a problem.
13 September 2005, 1:27 pmJon Peltier:
Measure once, cut twice, swear three times...
14 September 2005, 4:20 amSimon Towell:
Back in my University days our Operational Research Mathematics class (Dr Lynn was our lecturer if I remember correctly) was set the task of using linear programming and/or trim loss theory to work out how to minimise waste for a carpet manufacturer.
Obviously they sold rolls of carpet in various lengths and widths but cut from one roll.
I did come up with a neat solution in Algol but have never had the need to use it again (or translate it into any other language).
Professor George B. Dantzig invented the the "simplex method" and "linear programming" whilst at Stanford, so if you need more information look it up on the web!
Alternatively, email me and I might be able to find the Algol program!!!
16 September 2005, 5:36 amCarlos Arboleda:
Hi Simon. I would be interested in your Algol solution. I happen to like OR when I was in school and am curious to see your solution. I hope you can find it and share it. Thanks for your time.
CA
3 February 2006, 9:02 amEd Boyle:
Hello, first time here. Dick Kusleika - I work in the steel fabrication industry and could use your stock cutting VBA to some degree. What I would like to know is would it take much to have it tell me which pieces of which length to cut from each stock length. i.e., 2 pieces 18' 6" long to cut from a 40' 0" stock length piece. I would be dealing with hundreds of pieces of varying lengths from 1' 0" to 58' 0" being cut from 20' 0", 40' 0" and 60' 0" (various quantities of each) stock lengths as well as several random stock lengths left over from previous jobs.
Thank you, Ed
29 March 2006, 3:30 pmC Anderson:
Hello, first time here. Dick Kusleika - I work in framing industry and am very happy to find your cutting stock length program. Would you consider adding a few modifications to better fit my needs? I would be grateful and more than happy to pay you for your time.
30 June 2008, 9:29 pmjeff:
good day. i cant identify which cells or group of cell you renamed. like wshcuts, rinpstok, rinpcuts. please advice.
31 August 2008, 7:57 pm