Re: specific sum of combination of numbers in a sheet
no :)) i mean 75 numbers,and numbers are between 1 milion to 500 million( values)
Re: specific sum of combination of numbers in a sheet
no :)) i mean 75 numbers,and numbers are between 1 milion to 500 million( values)
Re: specific sum of combination of numbers in a sheet
Ok its an exponential increase , the five numbers is the kicker
Here is my problem
here is my native problem...
Re: specific sum of combination of numbers in a sheet
with a clean up of the record set and change Cint's to CDbl's
it works ok for up to three combinations
Re: specific sum of combination of numbers in a sheet
Woaaaaaawwwww ....prefect ... works like a charm
thanks a millionnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn:party:
Re: specific sum of combination of numbers in a sheet
Hi,
few more errors controlled ..it takes a few minutes but the combinations have been extended
Option Explicit
Dim a(), n As Double, r As Double
Dim numLeft As Double, total As Double
Sub test()
Dim myNums(), results(), com, n, i As Long
Dim sum As Double, targetValue As Double, setSize As Long
Dim combinations As Collection
Dim nums As Range, destR As Range, c As Range
Dim count As Long
Dim s As String
Columns("H:I").ClearContents
Set nums = Range("A2:A46")
If nums Is Nothing Then Exit Sub
Set destR = Range("H2")
If destR Is Nothing Then Exit Sub
targetValue = CDbl(Range("C2").Value)
setSize = CDbl(Range("E2").Value)
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
count = 0
ReDim myNums(0 To nums.count - 1)
For Each c In nums
If IsNumeric(c.Value) Then
myNums(count) = c.Value
count = count + 1
End If
Next c
ReDim Preserve myNums(0 To count - 1)
Set combinations = getCombinations(UBound(myNums) + 1, setSize)
ReDim results(1 To combinations.count, 1 To 2)
i = 1
For Each com In combinations
sum = 0
For Each n In Split(com, ",")
sum = sum + myNums(n)
If s = "" Then s = myNums(n) Else s = s & ", " & myNums(n)
Next
If sum = targetValue Then
results(i, 1) = s
results(i, 2) = sum
i = i + 1
End If
s = ""
Next com
If i > 1 Then
destR.Resize(i - 1, 2) = results
Else
destR.Value = "No Matches"
End If
End Sub
Private Function sort(ByRef n())
Dim sorted As Boolean
Dim tmp
Dim i As Long
sorted = False
do While Not sorted
sorted = True
For i = LBound(n) To UBound(n) - 1
If n(i + 1) < n(i) Then
tmp = n(i + 1)
n(i + 1) = n(i)
n(i) = tmp
sorted = False
End If
Next
loop
End Function
Public Function getCombinations(n1, r1) As Collection
Dim s As String, i
Dim results As New Collection
setup n1, r1
Do While numLeft > 0
getNext
For Each i In a
If s = "" Then s = i Else s = s & "," & i
Next
results.Add s
s = ""
Loop
Set getCombinations = results
End Function
Private Sub setup(n1, r1)
Dim nFact, rFact, nMinusRFact, i
n = n1
r = r1
ReDim a(0 To r - 1)
nFact = factorial(n)
rFact = factorial(r)
nMinusRFact = factorial(n - r)
total = nFact / (rFact * nMinusRFact)
For i = 0 To UBound(a)
a(i) = i
Next
numLeft = total
End Sub
Private Function factorial(n)
Dim fact As Double, i As Long
fact = 1
For i = n To 1 Step -1
fact = fact * i
Next
factorial = fact
End Function
Private Sub getNext()
Dim i As Long, j As Long
If numLeft <> total Then
i = r - 1
Do While a(i) = (n - r + i)
i = i - 1
If i = -1 Then Exit Do
Loop
If i <> -1 Then
a(i) = a(i) + 1
For j = i + 1 To r - 1
a(j) = a(i) + j - i
Next
End If
End If
numLeft = numLeft - 1
End Sub
Display More
Re: specific sum of combination of numbers in a sheet
its a Magic :witch: dear Pike
fantastic ..., Formidable
there is a question, can second column after matches ( column I ) show row number?
Re: specific sum of combination of numbers in a sheet
Hi,
changes to the routine below to at row numbers of values
Sub test()
Dim myNums(), results(), com, n, i As Long, z As String
Dim sum As Double, targetValue As Double, setSize As Long
Dim combinations As Collection
Dim nums As Range, destR As Range, c As Range
Dim count As Long
Dim s As String
Columns("H:I").ClearContents
Set nums = Range("A2", Cells(Rows.count, 1).End(xlUp))
If nums Is Nothing Then Exit Sub
Set destR = Range("H2")
If destR Is Nothing Then Exit Sub
targetValue = CDbl(Range("C2").Value)
setSize = CDbl(Range("E2").Value)
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
count = 0
ReDim myNums(0 To nums.count - 1)
For Each c In nums
If IsNumeric(c.Value) Then
myNums(count) = c.Value
count = count + 1
End If
Next c
ReDim Preserve myNums(0 To count - 1)
Set combinations = getCombinations(UBound(myNums) + 1, setSize)
ReDim results(1 To combinations.count, 1 To 3)
i = 1
For Each com In combinations
sum = 0
For Each n In Split(com, ",")
sum = sum + myNums(n)
If s = "" Then s = myNums(n) Else s = s & ", " & myNums(n)
If z = "" Then z = n + 1 Else z = z & ", " & n + 1
Next
If sum = targetValue Then
results(i, 1) = s
results(i, 2) = sum
results(i, 3) = z
i = i + 1
End If
s = ""
z = ""
Next com
If i > 1 Then
destR.Resize(i - 1, 3) = results
Else
destR.Value = "No Matches"
End If
End Sub
Display More
Re: specific sum of combination of numbers in a sheet
thanks a Biliion :flower:
Re: specific sum of combination of numbers in a sheet
no it replaces Sub test()
Don’t have an account yet? Register yourself now and be a part of our community!