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)
We will be implementing some important changes during 25th and 26th May 2024 which may result in an outage period of the website. We anticipate this process may take a couple of hours and so we apologise in advance for any inconvenience.
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!