Sum a range of values in best combnation to arrive at a target value

[Kamesh63]

Hi,
I have a column range of values. I need to sum the values in the 'best possible combination' to arrive at the target value (either equal to or less). By best possible I mean the sum result should be as close to target as possible.
Once the target is reached, the summing should start with remaining range of values to arrive at the target... an it goes on till entire range is exhausted. Basically, it is required to split the values in lot size of (say 25000). SO, if the sum of range of values is 100000, I need to make at east 4 lots. If the sum of range is 78000, still there will be 4 lots, the fourth lot having 3000.

The problem is the column range is huge and values are extremely variable. Appreciate some urgent help!

 

[AlanSidman]

Note where you need to change the 25000 as needed in the code. There are several instances that will require you to change.

Option Explicit

Sub Add25K()
    Dim lr As Long, i As Long, x As Long, y As Long, r As Long
    lr = Range("A" & Rows.Count).End(xlUp).Row
    x = 0
    For i = 2 To lr
        y = Range("B" & i).Value2
        x = x + y
        If x > 25000 Then 'Change this value in each line of code that requires adjustment to the right valuation
            x = x - y
            r = Range("B" & i - 1).Row
            Range("C" & r) = x
            GoTo Step2
        End If
    Next i
Step2:
    x = 0
    i = r
    For i = r + 1 To lr
        y = Range("B" & i).Value2
        x = x + y
        If x > 25000 Then
            x = x - y
            r = Range("B" & i - 1).Row
            Range("C" & r) = x
            GoTo Step3
        End If
    Next i
Step3:
    x = 0
    i = r
    For i = r + 1 To lr
        y = Range("B" & i).Value2
        x = x + y
        If x > 25000 Then
            x = x - y
            r = Range("B" & i - 1).Row
            Range("C" & r) = x
            GoTo Step4
        End If
    Next i
Step4:
    x = 0
    i = r
    For i = r + 1 To lr
        y = Range("B" & i).Value2
        x = x + y
        If x > 25000 Then
            x = x - y
            r = Range("B" & i - 1).Row
            Range("C" & r) = x
        End If
    Next i
    Exit Sub
End Sub