How can i let excel VBA sum up my list of variable values to a certain number and create multiple &q-CodePudding

good evening, im quite a long lurker here but i have ran into an issue i cant seem to find a solution for. i have no idea if i post this correctly as i dont have any base code to provide because im not sure if it is possible at all in VBA.

i have a list with values that is variable in size and the induvidual values range from 1 to 33. (this is based on pallet amounts in trucks) what i would like to be able to do is select that range and have a vba code sort out the best way to sum up my values to 33 (But never ever over 33!) and create an array with the values and move on to the next "set" and put the next values that add to 33 in a new array. i know how to do it chronically (thanks to another user here on stackoverflow) but that would mean that it isnt the most efficient option.

lets say i have a list of 5 different values:

10 15 8 22 19

this would create the following "sets":

25 30 19

but if the order of the 5 values would change to:

19 22 15 10 8

it would create the following sets:

19 22 15 18

now i have found a way to define a variable to the optimal number of trucks the code should create, but with the second list it would result in an error if the code i have now goes through that list chronically.

so to summarize, is it possible to create a code that would look at a selection of values and decide what the best most efficient way is of combining values the closest to 33.

ill provide the code i have now, please note it is not at all finished yet and very basic as its just the start of my project and pretty much the core feature of what i want to achieve. if i need to provide more info or details please let me know

thanks in advance. and many thanks to a huge group of people here who unbeknownst to themselves have already helped me save hours upon hours of work by providing their solutions to problems i had but didnt need to ask

here is my code:

Sub test()
Dim ref, b As Range
Dim volume, i As Integer
Dim test1(), check, total As Double
Dim c As Long


Set ref = Selection
volume = ref.Cells.Count
c = ref.Column
ReDim test1(1 To volume)

'this creates a total of all the values i select
For Each b In ref
    total = total   b
Next b

'this determines when to round up or down
check = total / 33 - Application.WorksheetFunction.RoundDown(total / 33, 0)
If check < 0.6 Then
    total = Application.WorksheetFunction.RoundDown(total / 33, 0)
Else
total = Application.WorksheetFunction.RoundUp(total / 33, 0)
End If

'this creates an array with all the values
i = 1
Do Until i = volume   1
    test1(i) = Cells(i, c).Value
    i = i   1
Loop



'this is just a way for me to check and verify my current part of the code
MsgBox (Round(test1(8), 2))
MsgBox (total)

End Sub

CodePudding user response：

You can change the cell result location as per your wish. I am showing the result in the immediate window.

Sub test()
Dim CellsCount As Integer

CellsCount = Selection.Cells.Count

Dim i, j As Long
Dim x, y As Long
Dim SumLoop As Long
SumLoop = 0
x = 1
y = 1

For i = x To CellsCount
    Do
        For j = y To CellsCount
            SumLoop = SumLoop   Selection.Cells(j).Value
            If SumLoop < 33 Then
                Debug.Print SumLoop
                y = j   1
                If y = CellsCount   1 Then Exit Sub
            Else
                
                SumLoop = 0
                x = j
                y = j
                Exit For
            End If
        Next
    Loop While SumLoop < 33
Next

End Sub

CodePudding user response：

This is a straight brute force, checking every single combination, if your set gets too big this will slow way down but it was <1 second on a set of 1,000.

I loaded values into Column A. Outputs the lowest amount of trucks you need.

You can probably reduce the amount of variables by using a type or class but wanted to keep it relatively simple.

    Dim i As Long
    Dim lr As Long
    Dim limit As Long
    Dim count As Long
    Dim sets As Long
    Dim best As Long
    Dim start As Long
    Dim addset As Boolean
    Dim loopcounter As Long
    
    limit = 33
    
    With Sheets("Sheet1")
        lr = .Cells(.Rows.count, 1).End(xlUp).Row
        Dim arr() As Long
        ReDim arr(0 To lr - 2)
        For i = 2 To lr
            arr(i - 2) = .Cells(i, 1).Value 'Load array
        Next i
        
        start = 0
        i = start
        Do
            If count   arr(i) <= limit Then
                count = count   arr(i)
                addset = False 'Just for tracking the final set
            Else
                addset = True
                sets = sets   1
                count = arr(i)
            End If
            i = i   1
            If i > UBound(arr) Then
                i = 0 'reset index
            End If
            loopcounter = loopcounter   1 'tracking items in set
            If loopcounter > UBound(arr) Then
                If addset = False Then
                    sets = sets   1 'adding final set if not already added
                End If
                Debug.Print start, sets
                If best > sets Or best = 0 Then
                    best = sets 'Get the lowest value
                End If
                'resetting values
                loopcounter = 0
                sets = 0
                start = start   1
                i = start
                If start > UBound(arr) Then
                    Exit Do
                End If
            End If
        Loop
    End With
    Debug.Print best