Formula that sums a column and puts totals of 24 in other columns

The attached is a VBA solution.

Data in Sheet "Pallets" must preferably be sorted in Descending order of Column F BUT it will work with F unsorted.

I have added data into F just for testing purposes.

Ranges within the macro may need to be changed (no doubt) to match your real data although I have tried to make everything dynamic.


Click RUN to execute macro

Sub Allocate_Pallets()

Dim LastRow As Long
Dim LastCol As Long
Dim InRng As Range
Dim OutRng As Range

Dim InArray As Variant
Dim OutArray() As Long

Dim r As Long
Dim c As Long

Dim rr As Long
Dim cc As Long
Dim ncol As Long

Dim PSum() As Long

Const pSize As Integer = 24

Dim ws1 As Worksheet

Application.ScreenUpdating = False

Set ws1 = Worksheets("Pallets")
ws1.Activate

With ActiveSheet
    LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
    
Set InRng = ws1.Range("F2:F" & LastRow)
Set OutRng = ws1.Range(Cells(2, 7), Cells(LastRow, LastCol - 3))
ncol = Round(Range("F" & LastRow + 1) / pSize, 1)

ReDim PSum(LastRow)
ReDim OutArray(LastRow, ncol + 2)
'
'  Read data into array
'
InArray = InRng

'
'  Clear output range
'

OutRng.ClearContents


cc = -1

Finished = False

'
' Loop through input array
'
lastnz = LastRow - 1

'
'  Allocate all full pallets initially
'

    For r = 1 To UBound(InArray, 1)
        For c = 1 To UBound(InArray, 2)
            If InArray(r, c) > 0 Then
                Do While InArray(r, c) >= pSize
                       cc = cc + 1
                       OutArray(r - 1, cc) = pSize
                       PSum(cc) = PSum(cc) + OutArray(r, cc)
                       InArray(r, c) = InArray(r, c) - pSize
                       
                 Loop
                 
            End If
        Next c
    Next r
'
'  Allocate remainder to pallets
'
   cc = cc + 1
   
    For r = 1 To UBound(InArray, 1)
        For c = 1 To UBound(InArray, 2)
        
            finish = True
            ix = 1
            '
            ' find "ix" th largest value
            '
            
            pValue = WorksheetFunction.Large(InArray, ix)
               '
               ' Loop adding to pallets to maximum (or nearest value)
               '
                Do While PSum(cc) < 24 And pValue > 0
                
                       finish = False
                       r = WorksheetFunction.Match(pValue, InArray, 0)
                       '
                       ' Check we will not exceed pallet limit
                       '
                        If PSum(cc) + pValue <= 24 Then
                            OutArray(r - 1, cc) = pValue
                            PSum(cc) = PSum(cc) + pValue
                            InArray(r, c) = InArray(r, c) - pValue
'
                        Else
                        
                         ix = ix + 1
'
                        End If
                        
                 pValue = WorksheetFunction.Large(InArray, ix)
                 
                 Loop
         '
         ' move to next load
         '
         cc = cc + 1
         
        Next c
        
        If finishtrue Then GoTo outp:
        
    Next r

outp:
'
'  Output results ....
'

OutRng = OutArray
'
'Sum pallets
'

For cc = 1 To ncol + 2
    c = cc + 5
    Cells(LastRow + 1, c) = Application.Sum(Range(Cells(2, c), Cells(LastRow, c)))
Next cc

Application.ScreenUpdating = True

End Sub