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