Sub BarCut()
Dim Rng As Range, sav As Variant, MyData As Variant, ctr(1 To 9999) As Long, bl As Double, ic As Double
Dim i As Long, j As Long, str1 As String, bool As Boolean, bn As Long, r As Long, barnum As Long
Dim bars As Variant, barqty As Long, itemqty As Long
Set Rng = Range("A2:C" & Cells(Rows.Count, "A").End(xlUp).Row)
sav = Rng.Value
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add2 Key:=Range("C2"), Order:=xlDescending
.SetRange Rng
.Header = xlNo
.Apply
End With
MyData = Rng.Value
Rng.Value = sav
barnum = 1
Range("H:I").ClearContents
itemqty = WorksheetFunction.Sum(Range("B2:B100"))
barqty = WorksheetFunction.Sum(Range("E2:E100"))
ic = Range("D2").Value
Range("H1").Value = "Results"
Range("I1").Value = "Length used"
bars = Range("E2:F" & Range("E999").End(xlUp).Row).Value
Do While itemqty > 0 And barqty > 0
For i = 1 To UBound(bars)
If bars(i, 1) > 0 Then
bl = bars(i, 2)
Exit For
End If
Next i
barused = 0
Erase ctr
bool = False
Do While bl > 0
For j = 1 To UBound(MyData)
If MyData(j, 2) > 0 And MyData(j, 3) <= bl Then
ctr(j) = ctr(j) + 1
bl = bl - MyData(j, 3) - ic
barused = barused + MyData(j, 3) + ic
MyData(j, 2) = MyData(j, 2) - 1
bool = True
itemqty = itemqty - 1
Exit For
End If
Next j
If j > UBound(MyData) Then Exit Do
Loop
If bool Then
str1 = "Bar " & barnum & ": "
For i = UBound(bars) To 1 Step -1
If bars(i, 2) > barused Then
bars(i, 1) = bars(i, 1) - 1
barqty = barqty - 1
Range("I100").End(xlUp).Offset(1).Value = bars(i, 2)
bl = bars(i, 2) - barused
Exit For
End If
Next i
For j = 1 To UBound(MyData)
If ctr(j) > 0 Then str1 = str1 & ctr(j) & " X " & MyData(j, 1) & ", "
Next j
str1 = str1 & "Leftover: " & bl
Range("H100").End(xlUp).Offset(1).Value = str1
barnum = barnum + 1
End If
Loop
bool = False
str1 = "Not made: "
For i = 1 To UBound(MyData)
If MyData(i, 2) > 0 Then
bool = True
str1 = str1 & MyData(i, 1) & " X " & MyData(i, 2) & ", "
End If
Next i
If bool Then Range("H100").End(xlUp).Offset(1).Value = str1
End Sub
