Combination of cells to match a specified cell

[msahmed]

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 them will be equal to a particular number (I will enter it in a specified cell). I want a code to get the cell address of that combination of cells. I have the below code which works fine if the entries are few. But usually, I get some 50-70 numbers of amounts and the code will be overloaded and all excel application will hang out. The code I'm using is as follows:

Option Explicit
Private Target As Double
Private EndRow As Integer
Private Limit As Integer
Private OutRow As Integer
Private CellCount As Integer
Private BlankCells As Integer
Private i As Integer
Private CellVal As String


Private Sub CommandButton1_Click()
Application.ScreenUpdating = True
    Columns(3).Clear
    Target = Range("B1").Value
    EndRow = Range("A1").End(xlDown).Row
    Limit = EndRow
    OutRow = 1
     Add1 1, 0, "", 0
     Call Replace
       
Range("C1").Select
ActiveCell.Offset(65000, 0).End(xlUp).Select
Range("C1", ActiveCell).Select
CellCount = WorksheetFunction.CountIf(Selection, "*")


Selection.Copy


Range("K1").Select


ActiveCell.PasteSpecial (xlPasteValues)
Application.CutCopyMode = False


i = 1
Range("K1").Select


Do Until i > CellCount


CellVal = ActiveCell.Text
ActiveCell.Value = "=" & CellVal
ActiveCell.Offset(1, 0).Select


i = i + 1
Loop


Range("A1").Select


     MsgBox "Perfect!!!!"
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).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            OneA = Cells(ThisRow, 1).Address
            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("i1").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

It would be great if you could help me resolve this issue. Is the code needs to be developed or is there any other excel function available with which we can do this quickly. I have also tried using the Solver Add-on, but even that didn't work


Thanks in Advance,


Best in,
Hussain

[Dave]

Where is the combination of cells (data) located. Where is the "specified cell". Is there a limit to how many cells combine to make up the specified cell. What if multiple combinations make up the specified cell? Also using select/selection is usually never required and only slows the code down. HTH. Dave

[msahmed]

Hi Dave,

Thanks for your time...

Cell "B1" is the specified cell ("Target = Range("B1").Value"), the numbers will be placed from cell "A1". There is no limit on the number of combinations to make up the specified cell. If there are multiple combinations, then all such combinations are to be noted down.

If you have any other questions, please let me know.

Thanks again,

Best in,
Hussain

[Dave]

50 to 70 numbers that can combine to make a single number.... I don't think a worksheet has enough rows to contain all the possible combinations. Anyways, here's an example of how U can use the random function to create a combination of 2 numbers to create a target value. U could expand the code to generate all possible combinations. To do this for 50-70 numbers would likely be useless. Good luck. Dave

Private Sub Combo()
'data in "A"
'Target number in "B1"
Randomize
With Sheets("Sheet1")
    Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
Cnt = 0
Do
abovefirstrow:
If Cnt > 1000 Then
MsgBox "No more matches"
Exit Sub
End If
firstrow = Int((Lastrow * Rnd) + 1)
secondrow = Int((Lastrow * Rnd) + 1)
If firstrow = secondrow Then
Cnt = Cnt + 1
GoTo abovefirstrow
End If
If Sheets("Sheet1").Range("A" & firstrow).Value + _
    Sheets("Sheet1").Range("A" & secondrow).Value = _
           Sheets("Sheet1").Range("B" & 1).Value Then
MsgBox "First Number " & Sheets("Sheet1").Range("A" & firstrow).Value & _
" Second Number " & Sheets("Sheet1").Range("A" & secondrow).Value
Exit Sub
End If
Loop
End Sub