Find values that add to a number

[Peter Atherton]

This is best done by macro. Two macros one for permtations
and one for combinations. The combination ABC can be
permed 6 ways.

Place the number to be added in G1
The values are in A1:A20 change this if necessary
Values are listed in Column C for Permutations and
Column J for combinations - make sure that these cells are
empty.

I've seen this query before, why do you want this I wonder?

Regards
Peter

Sub Permutations()
Dim srtT, endT, myTime 'used to calculate time
taken by procedure
Dim a, b, c
Dim v As Integer
Dim Rng As Range, Dest As Range
Dim count As Integer
srtT = Now() ‘Time when procedure starts
v = Range("G1").Value
Set Rng = Range("A1:A20")
For Each a In Rng
For Each b In Rng
For Each c In Rng
‘make sure that number are not duplicated
If a <> b And a <> c And b <> c And a + b + c = v Then
count = count + 1
With ActiveSheet
Set Dest = .Cells(.Rows.count, "C").End
(xlUp).Offset(1, 0)
End With
'enter the result as text
Dest.Formula = " = " & a & " + " & b & " + " & c
End If
Next c
Next b
Next a
endT = Now() ‘time when procedure is completed
myTime = endT – srtT ‘calculated running time
Range("H17").Value = myTime
MsgBox "There are " & count & "
Permutations", , "Permutations"
End Sub

The cominations macro is basically the same as the
permutations routine but with extra checking. As a
combination’s numbers

Sub combinations()
Dim srtT, endT, myTime
Dim v As Integer, count As Integer
Dim a, b, c, x, y, z ‘x, y & z are temp values for
checking
Dim Rng As Range, Dest As Range
v = Range("G1")
srtT = Now()
Set Rng = Range("A1:A20")
x = 0: y = 0: z = 0 'Initialise temp values
For Each a In Rng
For Each b In Rng
For Each c In Rng
If a <> b And a <> c And b <> c And a + b + c = v And _
a <> x And b <> y And c <> z And _
a <> x And b <> z And c <> y And _
b <> y And a <> x And c <> z And _
b <> y And c <> z And a <> x And _
c <> z And a <> x And b <> y And _
c <> z And b <> y And a <> x Then
x = a: y = b: z = c ‘swap temp values
count = count + 1
With ActiveSheet
Set Dest = .Cells(.Rows.count, "J").End
(xlUp).Offset(1, 0)
End With
'enter the result as text
Dest.Formula = " = " & a & " + " & b & " + " & c
End If
Next c
Next b
Next a
endT = Now()
myTime = endT - srtT
Range("H19").Value = myTime
MsgBox "There are " & count & "
Combinations", , "Combinations"
End Sub

 

[Myrna Larson]

I believe it MUST be done by a macro, but you have hard-coded it for a 3 out of 20. He wants
combinations of 6 out of 49. Unless you implement recursion, you need a total of 6 nexted loops.
I calculate ~14 million combinations. Did you time your code at all? I'm curious as to how fast
it is. (I gave up waiting for mine after about 15 minutes.)

BTW, I think this is to do with the lottery (again).