Basic Optimising with VBA Functions

[TSpan]

Hello All,

I know it can be done but I'm struggling to work out the correct way to do this....

I have 2 input cells: [Cut Length] and [Total Qty] and there are 6 standard lengths the Cut Length can be cut from. 9, 10.5, 12, 13.5, 15, and 16.5.

I need either 1 return cell that shows both the best length to cut from and the qty per length or in 2 separate cells.

I am doing this manually at the moment by manually inputting a stock length and checking the total meters until I get the smallest total meter length.

e.g. Qty = 10 and Cut length = 5.2m
The 9m stock length returns 10 lengths with a total of 90m (1 per length)
10.5m returns 5 lengths with a total of 52.5m (2 per length)
12m returns 5 lengths and 60m (2 per length)
13.5m returns 5 lengths and 67.5m (2 per length)
15m returns 5 lengths and 75m (2 per length)
16.5m returns 4 lengths and 66m (3 per length)

I would love this to be able to operate as a function if possible?

 

[TSpan]

In my mind i should be able to set up a loop that simply runs does the calculation on each stock length then picks the result with the lowest total length?

 

[Michael M]

Does this do what you require

Sub MM1()
ans = InputBox("What Quantity do you require ?")
ans2 = InputBox("What Cut Length are you using ?")
 SL9 = WorksheetFunction.RoundUp(ans / Int(9 / ans2), 0) * 9
 SL105 = WorksheetFunction.RoundUp(ans / Int(10.5 / ans2), 0) * 10.5
 SL12 = WorksheetFunction.RoundUp(ans / Int(12 / ans2), 0) * 12
 SL1305 = WorksheetFunction.RoundUp(ans / Int(13.5 / ans2), 0) * 13.5
 SL15 = WorksheetFunction.RoundUp(ans / Int(15 / ans2), 0) * 15
 SLl605 = WorksheetFunction.RoundUp(ans / Int(16.5 / ans2), 0) * 16.5
Dim Lgth
Lgth = SL9
 If SL105 < Lgth Then
 Lgth = SL105
 MsgBox "You wil need " & SL105 / 10.5 & " Lengths. Which is " & SL105 & " metres in Total"
 End If
 If SL12 < Lgth Then
 Lgth = SL12
 MsgBox "You wil need " & SL12 / 12 & " Lengths. Which is " & SL12 & " metres in Total"
 End If
 If SL1305 < Lgth Then
 Lgth = SL1305
MsgBox "You wil need " & SL1305 / 13.5 & " Lengths. Which is " & SL1305 & " metres in Total"
End If
 If SL15 < Lgth Then
 Lgth = SL15
MsgBox "You wil need " & SL15 / 15 & " Lengths. Which is " & SL15 & " metres in Total"
End If
 If SLl605 < Lgth Then
 Lgth = Sl1605
MsgBox "You wil need " & Sl1605 / 16.5 & " Lengths. Which is " & Sl1605 & " metres in Total"
End If
If Lgth = SL9 Then
MsgBox "You wil need " & SL9 / 9 & " Lengths. Which is " & SL9 & " metres in Total"
End If
End Sub

 

[TSpan]

Sub MM1() ans = InputBox("What Quantity do you require ?") ans2 = InputBox("What Cut Length are you using ?") SL9 = WorksheetFunction.RoundUp(ans / Int(9 / ans2), 0) * 9 SL105 = WorksheetFunction.RoundUp(ans / Int(10.5 / ans2), 0) * 10.5 SL12 = WorksheetFunction.RoundUp(ans / Int(12 / ans2), 0) * 12 SL1305 = WorksheetFunction.RoundUp(ans / Int(13.5 / ans2), 0) * 13.5 SL15 = WorksheetFunction.RoundUp(ans / Int(15 / ans2), 0) * 15 SLl605 = WorksheetFunction.RoundUp(ans / Int(16.5 / ans2), 0) * 16.5 Dim Lgth Lgth = SL9 If SL105 < Lgth Then Lgth = SL105 MsgBox "You wil need " & SL105 / 10.5 & " Lengths. Which is " & SL105 & " metres in Total" End If If SL12 < Lgth Then Lgth = SL12 MsgBox "You wil need " & SL12 / 12 & " Lengths. Which is " & SL12 & " metres in Total" End If If SL1305 < Lgth Then Lgth = SL1305 MsgBox "You wil need " & SL1305 / 13.5 & " Lengths. Which is " & SL1305 & " metres in Total" End If If SL15 < Lgth Then Lgth = SL15 MsgBox "You wil need " & SL15 / 15 & " Lengths. Which is " & SL15 & " metres in Total" End If If SLl605 < Lgth Then Lgth = Sl1605 MsgBox "You wil need " & Sl1605 / 16.5 & " Lengths. Which is " & Sl1605 & " metres in Total" End If If Lgth = SL9 Then MsgBox "You wil need " & SL9 / 9 & " Lengths. Which is " & SL9 & " metres in Total" End If End Sub

Thanks @Michael M that will work great
Only think is I would like it to be a bit more robust... I have a range on the sheet with the Stock Lengths and if this is updated or changed need the formula to update without rewriting the code. The number of length options could also change.
Can I do a for/next loop that sets each of the SL options and performs the calculation on each one - similar to the code below but I dont know how it all fits together!

Sub MM1()
ans = InputBox("What Quantity do you require ?")
ans2 = InputBox("What Cut Length are you using ?")
Set SL = Range 'Named range containing stock lengths eg. A3:A8
Dim Lgth
Do Until SL = Empty
    Bestfit = WorksheetFunction.RoundUp(ans / Int(SL / ans2), 0) * SL
        Lgth = Bestfit
'This is the start of the If Functions - i need to now run the calulation on the "Next SL" and check if it is less than Lgth.
'If it is then Lgth now becomes the new Bestfit. If not we keep looping through.
    SL105 = WorksheetFunction.RoundUp(ans / Int(10.5 / ans2), 0) * 10.5
    SL12 = WorksheetFunction.RoundUp(ans / Int(12 / ans2), 0) * 12
    SL1305 = WorksheetFunction.RoundUp(ans / Int(13.5 / ans2), 0) * 13.5
    SL15 = WorksheetFunction.RoundUp(ans / Int(15 / ans2), 0) * 15
    SLl605 = WorksheetFunction.RoundUp(ans / Int(16.5 / ans2), 0) * 16.5

 If SL < Lgth Then
 Lgth = SL105
 MsgBox "You will need " & Bestfit / SL & " Lengths of " & SL & "Lengths. Which is " & SL * Bestfit & " metres in Total"
 End If
 
End Sub

 

[Michael M]

Maybe this then....ONLY PARTIALLY TESTED

Sub MM1()
ans = InputBox("What Quantity do you require ?")
ans2 = InputBox("What Cut Length are you using ?")
Set SL = Range("A2:A7") 'Table starts at cell 2
n = 2
tot = WorksheetFunction.RoundUp(ans / Int(Range("A1").Value / ans2), 0) * Range("A1").Value ' first value in tabler stes the scene
    For Each cell In SL
    SL(n) = WorksheetFunction.RoundUp(ans / Int(cell / ans2), 0) * cell 'frm then on uses (n) as the next cell in the range
        If SL(n) < tot Then
            tot = SL(n)
            x = cell.Value
        End If
    Next cell
MsgBox "You will need " & WorksheetFunction.RoundUp((tot / x), 0) & " Cuts of Steel Using " & x & "m Lengths. Which is " & tot & " metres in Total"
End Sub

 

[TSpan]

Yes perfect with a small tweak...! It was changing the value in the SL range so I changed it as per below.

Qty = InputBox("What Quantity do you require ?")
CutLength = InputBox("What Cut Length are you using ?")
Set SL = Range("Stock_Lengths") 'I used a named range here
tot = WorksheetFunction.RoundUp(Qty / Int(SL(1).Value / CutLength), 0) * SL(1).Value ' first value in table sets the scene
Stock_Length = SL(1).Value 'Added this to capture Stock_Length if the first value was the best one.
    For Each cell In SL
    BestFit = WorksheetFunction.RoundUp(Qty / Int(cell / CutLength), 0) * cell 'didnt seem to need the (n) to loop?
        If BestFit < tot Then
            tot = BestFit
            Stock_Length = cell.Value
        End If
    Next cell
MsgBox "You will need " & WorksheetFunction.RoundUp((tot / Stock_Length), 0) & " Stock_Length " & x & "m stock lengths. Which is " & tot & " metres in Total" 'Slight change to the message
End Sub

Only problem now is its throwing an error if the length i input is over 9 (the smallest stock length) as it tries to divide by zero. How can we get an error capture in it so it continues to the next value if it does this?

 

[TSpan]

I think I got it...!

Sub Steel_BestFit()
Qty = InputBox("What Quantity do you require ?")
CutLength = InputBox("What Cut Length are you using ?")
Set SL = Range("Stock_Lengths")

    For Each cell In SL
    If tot = "" Then 'Goes through this if statement until we have a total length value
    On Error Resume Next 'If the first stock length is less than the cut length required we ignore so it doesnt try and divide by zero
    tot = WorksheetFunction.RoundUp(Qty / Int(cell / CutLength), 0) * cell.Value ' first value that doesnt throw an error sets the scene
        Stock_Length = cell.Value 'Sets stock length as the first available option.
    End If
    BestFit = WorksheetFunction.RoundUp(Qty / Int(cell / CutLength), 0) * cell
        If BestFit < tot Then
            tot = BestFit
            Stock_Length = cell.Value ' Sets new stock length
        End If
    Next cell
MsgBox "You will need " & WorksheetFunction.RoundUp((tot / Stock_Length), 0) & " x " & Stock_Length & "m stock lengths. Which is " & tot & " metres in Total"
End Sub

I have now set this as a public function with the qty and cut lengths as inputs "Public Function Stock(Qty, CutLength)" which returns the "Stock_Length" value. I have standard calculations running on the worksheet to give us the total m required and how many we cut from each stock length.

Works perfect thanks @Michael M for your help!

 

[Michael M]

Okay....well, as I said earlier, seems you worked it out yourself...

 

[TSpan]

Okay....well, as I said earlier, seems you worked it out yourself...

I know what i want/need in my head... i just struggle to get it into code! Haha... I needed your help to tell me what went where.
Appreciate your help!

 

[Michael M]

Just Playing now !!....See the last MsgBox !

Sub Steel_BestFit()
qty = InputBox("What Quantity do you require ?")
cutlength = InputBox("What Cut Length are you using ?")
Set SL = Range("Stock_Lengths")
    For Each cell In SL
    If tot = "" Then 'Goes through this if statement until we have a total length value
    On Error Resume Next 'If the first stock length is less than the cut length required we ignore so it doesnt try and divide by zero
    tot = WorksheetFunction.RoundUp(qty / Int(cell / cutlength), 0) * cell.Value ' first value that doesnt throw an error sets the scene
        Stock_Length = cell.Value 'Sets stock length as the first available option.
    End If
    BestFit = WorksheetFunction.RoundUp(qty / Int(cell / cutlength), 0) * cell
        If BestFit < tot Then
            tot = BestFit
            Stock_Length = cell.Value ' Sets new stock length
        End If
    Next cell
waste = tot - (qty * cutlength)
MsgBox "You will need " & WorksheetFunction.RoundUp((tot / Stock_Length), 0) & " x " & Stock_Length & "m stock lengths. Which is " & tot & " metres in Total"
MsgBox "There will be " & waste & " m of waste product, Which Is " & waste / WorksheetFunction.RoundUp((tot / Stock_Length), 1) & " per Length !!"
End Sub