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