How to allocate using a loop in macro VBA?

I have a dataset that i would like to perform allocation on, below are the constraints:

1. Each container can only contain 310 pieces
2. We can mix colours, but the point is the maximise the 310

The code below is able to loop through every colour and split them into multiples of 310. however, when it reaches white and chalk, the code breaks.

For the code to work correctly, we should put 160 white, 120 chalk and 30 red in 1 container (in the same row).

As the code below iterates by columns, it does not work when the column next to it is a 0, and the container has not reached maximum capacity. It pushes the next available value to the next container

Sub sum_of_substract()
Dim i, r As Integer
Dim another As Integer
Dim LastRow As Long
LastRow = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
r = 5

Cells(LastRow + 1, 2).Formula = "=SUM(C" & LastRow + 1 & ":CO" & LastRow + 1 & ")"
For i = 3 To 93
While (Cells(4, i).Value) > 0
    If IsEmpty(ActiveSheet.Cells(4, i)) = False And Cells(4, i).Value < 310 And Cells(LastRow + 1, Value + Cells(4, i + 1).Value <= 310 Then
        Cells(LastRow + 1, 2).Formula = "=SUM(C" & LastRow + 1 & ":CO" & LastRow + 1 & ")"
        Cells(LastRow + 1, i).Value = Cells(4, i).Value
        Cells(4, i).Value = Cells(4, i).Value - Cells(4, i).Value
        Cells(LastRow + 1, i + 1).Value = Cells(4, i + 1).Value
        Cells(4, i + 1).Value = Cells(4, i + 1).Value - Cells(4, i + 1).Value
    
    
    
    ElseIf ActiveSheet.Cells(4, i) <> 0 And Cells(4, i).Value < 310 And Cells(LastRow + 1, 2).Value + Cells(4, i + 1).Value > 310 Then
        Cells(LastRow + 1, i + 1).Value = Cells(LastRow + 1, 2).Value - Cells(4, i + 1).Value
        Cells(LastRow + 1, 2).Formula = "=SUM(C" & LastRow + 1 & ":CO" & LastRow + 1 & ")"

    
    Else
        Cells(LastRow + 1, i).Value = 310
        Cells(4, i).Value = Cells(4, i).Value - 310
        Cells(LastRow + 1, 2).Formula = "=SUM(C" & LastRow + 1 & ":CO" & LastRow + 1 & ")"

    
End If
    LastRow = LastRow + 1

Wend

Next i

End Sub

Dataset