I managed to find this nice simple cut list optimizer macro that someone made. It was on another forum site, and I can't find the original post to save my life. Original file was called BoardFeet. I'm not that well versed in VBA code, but I'm trying to figure out a way to output the cut measurements on a separate sheet instead of a message box. How would I go about doing that? Code attached below.
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 End Sub