Herbert Seidenberg wrote...
>Here is a fast way (.4 sec) to find a set o 10 numbers (Num_Sel) out of
>a set of 20 numbers (Bin1) that add up to (Total).

....

What's magic about 10 out of 20 numbers?

>The first 10 columns of your Sheet1 are reserved for the several
>thousand (Pcount) answers. Do not use these columns for the following
>entries:

....

And you eat worksheet cells!

Why not create a new worksheet to store temporary results?

>Sub sum_perm()

....
>For i = 1 To NN
> For j = i + 1 To NN
> For k = j + 1 To NN
> For m = k + 1 To NN
> For n = m + 1 To NN
> For r = n + 1 To NN
> For s = r + 1 To NN
> For t = s + 1 To NN
> For u = t + 1 To NN
> For v = u + 1 To NN

....

Ah, brute force.

I've finally been tempted to do this myself. Brute force is
unfortunately necessary for this sort of problem, but there are better
control flows than hardcoded nested For loops.


Sub foo()
'This *REQUIRES* VBAProject references to
'Microsoft Scripting Runtime
'Microsoft VBScript Regular Expressions 1.0

Dim i As Long, n As Long, t As Double, u As Double
Dim x As Variant, y As Variant
Dim dv As New Dictionary, dc As New Dictionary
Dim re As New RegExp

re.Global = True
re.IgnoreCase = True

t = Range("A23").Value2 'target value - HARDCODED

For Each x In Range("A1:A20").Value2 'set of values - HARDCODED

If VarType(x) = vbDouble Then

If dv.Exists(x) Then
dv(x) = dv(x) + 1

ElseIf x = t Then
GoTo SolutionFound

ElseIf x < t Then
dc.Add Key:=Format(x), Item:=x
dv.Add Key:=x, Item:=1

End If

End If

Next x

For n = 2 To dv.Count

For Each x In dv.Keys

For Each y In dc.Keys
re.Pattern = "(^|\+)" & Format(x) & "(\+|$)"

If re.Execute(y).Count < dv(x) Then
u = dc(y) + x

If u = t Then
GoTo SolutionFound

ElseIf u < t Then
dc.Add Key:=y & "+" & Format(x), Item:=u

End If

End If

Next y

Next x

Next n

MsgBox Prompt:="all combinations exhausted", Title:="No Solution"

Exit Sub


SolutionFound:

If IsEmpty(y) Then
y = Format(x)
n = dc.Count + 1

Else
y = y & "+" & Format(x)
n = dc.Count

End If

MsgBox Prompt:=y, Title:="Solution (" & Format(n) & ")"

End Sub


The initial loop loads a dictionary object (dv) with the numeric values
from the specified range, storing distinct values as keys and the
number of instances of each distinct values as items.

It tracks combinations of values from the original set using a
dictionary object (dc) in which the keys are the symbolic sums (e.g.,
"1+2+3") and the items are the evaluated numeric sums (e.g., 6). It
uses a regex Execute call to ensure that each distinct value appears no
more times than it appears in the original set.

New combinations are added to dc only when their sums are less than the
target value. This implicitly eliminates larger cardinality
combinations of sums which would exceed the target value, thus
partially mitigating the O(2^N) runtime that's unavoidable from this
sort of problem.

FWIW, my test data in A1:A20 was

692
506
765
97
47
949
811
187
537
217
687
443
117
248
580
506
449
309
393
507

and the formula for my target value in A23 was

=A2+A3+A5+A7+A11+A13+A17+A19

which evaluates to 3775. When I ran the macro above, it returned the
solution

687+506+765+97+47+949+187+537

which is equivalent to

=A11+A2+A3+A4+A5+A6+A8+A9