Combination of cells to match a specified cell

0

Hi there,

I don't know how to say this, but I will try explaining you in detail. I have some cells containing different amounts of which, a combination of cells will be equal to a particular number (I will enter it in a specified cell). I want to get that combination of cells address. I have the below code which works fine if the entries are few, but usually, I get some 50-70 numbers of amounts which results in the excel application getting hung out.

I know that there could be n number of combinations for getting the amount, but, I have an idea to limit the number of cells that need to get the total, say 4 cells or 5 cells or 7 cells... n cells combine to get that amount, this could lower the burden of the system. I tried this for long, but am not getting how to sort out the code. 

Any suggestion or code would be very helpful.

The code I use is as follows:

Option Explicit
Private Target As Double
Private EndRow As Integer
Private Limit As Integer
Private OutRow As Integer
Private Sub CommandButton1_Click()
Application.ScreenUpdating = True
    Columns(3).Clear
    Target = Range("B2").Value
    EndRow = Range("A2").End(xlDown).Row
    Limit = 50
    OutRow = 1
     Add1 1, 0, "", 0
     MsgBox "Great Done It"
End Sub
Private Sub Add1(ByVal BegRow As Integer, ByVal SumSoFar As Double, _
  ByVal OutSoFar As String, ByVal Num As Integer)
    Dim ThisRow As Long
    Dim OneA As String
    Application.ScreenUpdating = True
        If (BegRow <= EndRow) And (SumSoFar < Target) And (Num < Limit) Then
        For ThisRow = BegRow To EndRow
            OneA = Cells(ThisRow, 1).Value(RowAbsolute:=False, ColumnAbsolute:=False)
            If OutSoFar <> "" Then
                OneA = " + " & OneA
            End If
            If (Round(SumSoFar + Cells(ThisRow, 1).Value, 2) = Target) And (Num > 0) Then
                Cells(OutRow, 3).Value = OutSoFar & OneA
                OutRow = OutRow + 1
            Else
                Add1 ThisRow + 1, Round(SumSoFar + Cells(ThisRow, 1).Value, 2), _
                OutSoFar & OneA, Num + 1
            End If
        Next ThisRow
        End If
        End Sub
        Public Sub Replace()
        Range("C1").Select
        Range(Selection, Selection.End(xlDown)).Select
           Selection.Copy
    Range("F1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Selection.Replace What:="a", Replacement:="e", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="+", Replacement:="&", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        Selection.Columns.AutoFit
        Application.CutCopyMode = False
        Range("a1").Select
End Sub
Answer
Discuss

Answers

0

Your code contains a fatal syntax error. OneA = Cells(ThisRow, 1).Value(RowAbsolute:=False, ColumnAbsolute:=False) can't work. It should be

OneA = Cells(ThisRow, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False)

I believe your project also has an equally fatal logical flaw. "If (Round(SumSoFar + Cells(ThisRow, 1).Value, 2) = Target)" is a condition which is highly unlikely to ever be fulfilled. This causes your sub to call itself recursively until the computer runs out of memory and crashes.

Perhaps I don't understand your intention correctly but if your question is "which numbers in column C add up to the Target [of 50]"? then you first need to guarantee that there actually is at least one such combination, or provide an "out" for the code to fail finding it.

Secondly, if you have 50 to 70 values in column C there must be literally millions of combinations, one, some or none of which fits your requirements.You would need code which systematically tries every possible combination. Your code seems to make no such attempt.

Discuss

Answer the Question

You must create an account to use the forum. Create an Account or Login