Need Help with calculating an array of numbers...

[ChrisKustom]

Hi guys,

This being my first post i thought id make it an interesting one.

I have a total -> (for this example lets say 300)
I also have a list of numbers in 1 column.
100
150
50
100
200
250
75
12
14

I was wondering if there is a way of looking at that list of numbers, and find the most effecient (using as few numbers as possible, and acheieve the closest match to my total) calculation to acheive my total?
(in this example, it would be 250 + 50)

But the list and total will change after each calculation.

So does anyone know if it is possible to achieve this through VBA or Excel formula?

Thank you in advance (This is driving me insane)

[Jacob Hilderbrand]

This pops up from time to time, generally dealing with accounting where a bill is paid but you don't know what invoices are being paid and need to match it up.

The problem is that there can be many matches and as your group of numbers increases, the possible matches also goes up to the point where there are too many matches to deal with.

For example:

250 + 50
150 + 100 + 50
200 + 100

You have to loop through the possibilities to get all the matches. But if you wanted to get the first match using the largest numbers first, or the first match using the smallest numbers first then you could stop once a match was found.

[ChrisKustom]

Righto, thank you for your response.

Any idea how i might go about doing that?

[mikerickson]

This problem can be approached with the Greedy Algorithm (https://en.wikipedia.org/wiki/Greedy_algorithm).

[Kenneth Hobs]

The approach that Mike said could be the fastest way to get a solution. First, sort the array. Then pick the first element and add one of the numbers from the bottom and keep doing that until you get the target value or your total exceeds the target. To find a 3 number match, pick the middle value and then add the top and bottom numbers and iterate to match or exceeding match. Four numbers would be like case 1.

A more involved solution is to find all 2 number combination sums. Then do 3, then 4, and so on. As you can see, it gets rather involved. If you don't exceed 2 or 3 combinations from 100 or so numbers, that is not too bad.

[Jacob Hilderbrand]

If you wanted to match 1, 2, or 3 or some finite number of values you can setup a look to check the values and get the matches.


Option Explicit


Sub MatchValues()


Dim i As Long
Dim j As Long
Dim k As Long
Dim LastRow As Long
Dim TargetValue As Double


TargetValue = 300
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LastRow - 2
For j = i + 1 To LastRow - 1
For k = j + 1 To LastRow
If Range("A" & i).Value = TargetValue Then
MsgBox "Match: " & Range("A" & i).Value
Exit Sub
ElseIf Range("A" & i).Value + Range("A" & j).Value = TargetValue Then
MsgBox "Match: " & Range("A" & i).Value & " + " & Range("A" & j).Value
Exit Sub
ElseIf Range("A" & i).Value + Range("A" & j).Value + Range("A" & k).Value = TargetValue Then
MsgBox "Match: " & Range("A" & i).Value & " + " & Range("A" & j).Value & " + " & Range("A" & k).Value
Exit Sub
End If
Next k
Next j
Next i


End Sub


If you wanted to check all the combinations then you would need a recursive loop. In this example it will get the values from column A and put the results in column B. The results are limited to those that match the target value, in this case 300.

But this one would be slow if there are more values added.


Option Explicit

Sub ProcessData()


Dim i As Long
Dim j As Long
Dim Row As Long
Dim LastRow As Long
Dim TargetValue As Double
Dim ArrayA() As String
Dim ArrayB As Variant


Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

TargetValue = 300

LastRow = Range("A" & Rows.Count).End(xlUp).Row
ReDim ArrayA(0 To LastRow - 1)
For i = 1 To LastRow
ArrayA(i - 1) = Range("A" & i).Value
Next i

Range("B:B").ClearContents
Row = 2
For i = LBound(ArrayA) To UBound(ArrayA)
ArrayB = GetCombinations(ArrayA, i + 1)

For j = LBound(ArrayB) To UBound(ArrayB)
If Evaluate(ArrayB(j)) = TargetValue Then
Range("B" & Row).Value = ArrayB(j)
Row = Row + 1
End If
Next j
Next i
Range("B:B").EntireColumn.AutoFit

ExitSub:

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Public Function GetCombinations(Arr, n As Integer)


GetCombinations = GetSubset(Arr, n)


End Function

Public Function GetSubset(Arr, n As Integer)


Dim Result() As String


ReDim Result(0)

Subset Arr, LBound(Arr), n, "", Result
ReDim Preserve Result(UBound(Result) - 1)
GetSubset = Result

End Function

Private Sub Subset(Arr, Index, n, ByVal PreString As String, ByRef Result)


Dim i As Long


If n = 0 Then
If PreString = "" Then
Result(UBound(Result)) = PreString
Else
Result(UBound(Result)) = Left(PreString, Len(PreString) - Len("+"))
End If
ReDim Preserve Result(UBound(Result) + 1)
Else
For i = Index To UBound(Arr) - LBound(Arr) + 1 - n + LBound(Arr)
Subset Arr, i + 1, n - 1, PreString & Arr(i) & "+", Result
Next i
End If

End Sub

[ChrisKustom]

Thank DRJ!

Thats exactly what I'm looking for.
Now all i have to do is reduce the list to only show the smallest combinations, regardless of how big, as long as it is the smallest. If that makes sense?

Thanks guys.