Combination of Numbers Totalling Desired Sum

Can you upload example workbook?

example uploaded

Here are directions for use:

Place list of numbers is Row 1 starting in Cell A1.
Leave NO blank Cells.
Zero is NOT allowed in Row 1.
Numbers on list in Row 1 can be positive or negative.

Place the number for Total in Cell A2.

Run Sub AddCombo.
Results appear beginning in Row 3.
Will give any combinations on list with sum that results in Total.
You can check for those that result from 5 accounts.
Excel 2007 has enough Columns for this.

Code below can go in a standard module.
Code applies to the active sheet.

This will clear the active sheet.
This allows the column width to be set in the code with the Constant cKolWid.

Option Explicit
Const cKolWid As Long = 4
Sub AddCombo()
Dim dNeg As Double, dTotal As Double
Dim lCol As Long, lJ As Long, lRw As Long
Dim vIn As Variant, vRow As Variant
dTotal = Range("A2").Value
Rows(2).Clear
With Range("A1").CurrentRegion
    lCol = .Columns.Count
    vIn = .Value
    Cells.ClearContents
    .Value = vIn
End With
Range("A2").Value = dTotal
If lCol < 2 Then
    MsgBox "Must Be At Least Two On List"
    Exit Sub
End If
dNeg = 0
For lJ = 1 To lCol
    If vIn(1, lJ) = 0 Then
        MsgBox "Zero Not Allowed In First Row"
        Exit Sub
    End If
    If vIn(1, lJ) < 0 Then dNeg = dNeg + vIn(1, lJ)
Next lJ
Application.ScreenUpdating = False
For lJ = 1 To lCol
    Columns(lJ).ColumnWidth = cKolWid
Next lJ
If lCol < Columns.Count Then
    For lJ = 1 To 30
        Columns(lCol + 1).Delete
    Next lJ
End If
Application.ScreenUpdating = True
ReDim vRow(1 To lCol)
lRw = 0
AddCombo1 vIn, vRow, dNeg, dTotal, 0, lRw, 1, lCol, False
If dTotal = 0 Then Rows(3).Delete
If lRw = 0 Then MsgBox "No Combinations Found"
End Sub
Sub AddCombo1(ByVal vIn As Variant, ByVal vRow As Variant, ByVal dNeg As Double, _
    ByVal dTotal As Double, ByVal dKalc As Double, ByRef lRw As Long, _
    ByVal lKol As Long, ByVal lCol As Long, ByRef bMax As Boolean)
If bMax = True Then Exit Sub
Dim lJ As Long
For lJ = 0 To 1
    If lJ = 1 Then
        dKalc = dKalc + vIn(1, lKol)
        If vIn(1, lKol) < 0 Then dNeg = dNeg - vIn(1, lKol)
        If dKalc > dTotal - dNeg Then Exit Sub
        vRow(lKol) = vIn(1, lKol)
    End If
    If lKol = lCol Then
        If dKalc = dTotal Then
            lRw = lRw + 1
            If lRw > Rows.Count - 2 Then
                bMax = True
                MsgBox "All Rows Filled"
                Exit Sub
            End If
            Range("A" & lRw + 2).Resize(1, lCol) = vRow
        End If
    Else
        AddCombo1 vIn, vRow, dNeg, dTotal, dKalc, lRw, lKol + 1, lCol, bMax
    End If
Next lJ
End Sub

Hey Shg,

I was wondering where the results of this macro are displayed? I followed the prompted instructions for my listing of values and got no output.

Originally Posted by contra19

I have a simple list with 2 columns which hold account numbers in column 1 and amounts in column 2. I have a total (sum) for 5 accounts which did not show on a report. So I need to find 5 accounts in a list of roughly 2300 accounts only knowing a total amount (sum) and that I need 5 amounts to make up this sum. Algebraically the formula would be x+y+z+a+b= c where c = predefined sum.

I am hoping to make some kind of loop that will continue until the possibilities are exhausted.

I know this is ridiculous

It is ... number of possible combinations: 534033454837960
It is not a problem to create a loop but it's unknown in how many hours or days you will get the result (all possible combinations for the amount)