Can this be done in Excel?

[ian123]

Tom,

Thanks for your help - unfortunately its not working for me. I thin
its just a small problem but i'm not experienced enough to solve it
can you help please.

on running the macro the word ''bldbin'' in the line:
bldbin i, bits, varr1
is highlighted with the message box "compile error: sub or function no
defined"

Please excuse any elementary errors on my behalf. Once again your hel
is much appreciate

 

[Doug Glancy]

Tom,

Can you give an explanation of the function of "varr" below? Is it a
variant array? How can you assign a range to it? This is something I know
I've read about and I was trying to do in my original answer to this post,
but was unable to figure out.

tia,

Doug

 

[Doug Glancy]

Ian,

While you're waiting for Tom, does this help? A couple of variables (cnt,
num and tot) weren't dimensioned in the original code, which would cause
problems if you've specified "Option Explicit." I dimmed them as Longs, and
it works for me.

hth,

Doug

Sub bldbin(num As Long, bits As Long, arr() As Long)
Dim lNum, cnt, i As Long
lNum = num
' Dim sStr As String
' sStr = ""

cnt = 0
For i = bits - 1 To 0 Step -1
If lNum And 2 ^ i Then
cnt = cnt + 1
arr(i, 0) = 1
' sStr = sStr & "1"
Else
arr(i, 0) = 0
' sStr = sStr & "0"
End If
Next
' If cnt = 2 Then
' Debug.Print num, sStr
' End If
End Sub


Sub TestBldbin()
Dim i As Long
Dim bits As Long
Dim varr As Variant
Dim varr1() As Long
Dim num As Long
Dim tot As Long
Dim rng As Range
Dim icol As Long
icol = 0
Set rng = Range(Range("B1"), Range("B1").End(xlDown))
num = 2 ^ rng.Count - 1
bits = rng.Count
varr = rng.Value
ReDim varr1(0 To bits - 1, 0 To 0)
For i = 0 To num
bldbin i, bits, varr1
tot = Application.SumProduct(varr, varr1)
If tot = Range("A1") Then
icol = icol + 1
rng.Offset(0, icol) = varr1
If icol = 256 Then
MsgBox "too many columns, i is " & i & " of " & num & _
" combinations checked"
Exit Sub
End If
End If
Next
End Sub

 

[Tom Ogilvy]

bldbin is the first sub. Apparently you haven't copied the code correctly.

 

[Tom Ogilvy]

Also, my code isn't going to work for 50 values . The number of
combinations you would have to check would be 1,125,899,906,842,620 for 50
numbers. Not sure there is enough time left to check that many
combinations.
If you only want one solution, I believe the solver method would give you a
single solution.

 

[Tom Ogilvy]

varr is a variant. When assigned to a range.value, it holds a two
dimensional array 1 to #rows, 1 to # Columns. In this case the # of
columns is 1.

 

[Tom Ogilvy]

My column protection code was a little screwed up. Here is the correction:

Sub bldbin(num As Long, bits As Long, arr() As Long)
Dim lNum As Long, i As Long
lNum = num
' Dim sStr As String
' sStr = ""
cnt = 0
For i = bits - 1 To 0 Step -1
If lNum And 2 ^ i Then
cnt = cnt + 1
arr(i, 0) = 1
' sStr = sStr & "1"
Else
arr(i, 0) = 0
' sStr = sStr & "0"
End If
Next
' If cnt = 2 Then
' Debug.Print num, sStr
' End If
End Sub

Sub TestBldbin()
Dim i As Long
Dim bits As Long
Dim varr As Variant
Dim varr1() As Long
Dim rng As Range
Dim icol As Long
icol = 0
Set rng = Range(Range("B1"), Range("B1").End(xlDown))
num = 2 ^ rng.Count - 1
bits = rng.Count
varr = rng.Value
ReDim varr1(0 To bits - 1, 0 To 0)
For i = 0 To num
bldbin i, bits, varr1
tot = Application.SumProduct(varr, varr1)
If tot = Range("A1") Then
icol = icol + 1
If icol = 255 Then
MsgBox "too many columns, i is " & i & " of " & num & _
" combinations checked"
Exit Sub
End If
rng.Offset(0, icol) = varr1
End If
Next
End Sub

 

[ian123]

Guys,

Many thanks for all of your help - i feel like i'm getting close to
getting this working! Unfortunately i can't quite follow what i'm
supposed to be doing so i was wondering if oneof you would be so kind
as to sum up in one thread what i am supposed to do in order to answer
my original query. In particular i'm struggling to understand how the
2 subs come together... Thanks again for your help, i really appreciate
you guys taking the time to help make my life easier.

(I apologise for my inability to solve this myself )

 

[Tom Ogilvy]

the code should go in a general module - not a sheet module. It should
result in two subs (testbldbin and bldbin)

On the active sheet, put the amount to sum to in A1. In column B, starting
in B1 should go the values to construct the sum from.

Then you run TestBldbin from tools=>Macro=>macros.

Not much more to explain beyond that.

 

[twalls2]

The non-macro approach that Tom Ogilvy posted the link to above which
was his answer to a similar need of someone else before, is the one
that does exactly what I needed it to do in my situation. It is
instantaneous and uses Binary and puts a 1 beside all the numbers
included in the combination and a 0 beside the ones not included. Works
great for me! So thanks very much Tom and also thanks to Doug and Greg
for all your time and input as well. All you guys amaze me with your
talents and abilities that the Lord Jesus has blessed you with.

Here's Toms link again:

http://groups.google.com/groups?thr...2msftngp13.phx.gbl


Thanks,

Troy

 

[twalls2]

http://groups.google.com/[email protected]

 

[ian123]

To all of you who have offered help on this subject, and in particular
Tom, may i say a huge thank you - you have given me a tool that will
save me hours of menial work in the coming months. And not only that
but your patience and understanding to an inexperienced user is much
appreciated.

 

[Brad]

This little macro will do it perfectly ... So far.

Need to just put the result required in a cell named ³ans² and then the
values required in a column. Just click on the first value and run ...

I¹m sure there is other ways around the problem, but it doesn¹t look like
anyone has given many ideas ...

Brad.)


Sub findsums()

Dim pos As Integer

Dim rng As Range
Dim cell As Object
Dim testvalue As Integer
Dim test As Integer
Dim triga As Integer
Dim trigb As Integer
Dim trigc As Integer
Dim trigd As Integer
Dim trige As Integer
Dim trigf As Integer
Dim trigg As Integer
Dim trigh As Integer
Dim trigi As Integer
Dim trigj As Integer
Dim trigk As Integer
Dim trigl As Integer
Dim trigm As Integer
Dim trign As Integer

Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, f
As Integer, g As Integer, h As Integer, i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim n As Integer
Dim result As String
Set rng = Selection
testvalue = Range("ans").Value
MsgBox testvalue & " is being tested"
pos = 1
For triga = 0 To 1
For trigb = 0 To 1
For trigc = 0 To 1
For trigd = 0 To 1
For trige = 0 To 1
For trigf = 0 To 1
For trigg = 0 To 1
For trigh = 0 To 1
For trigi = 0 To 1
For trigj = 0 To 1
For trigk = 0 To 1
For trigl = 0 To 1
For trigm = 0 To 1
For trign = 0 To 1


a = rng.Cells(1, 1).Value * triga
b = rng.Cells(2, 1).Value * trigb
c = rng.Cells(3, 1).Value * trigc
d = rng.Cells(4, 1).Value * trigd
e = rng.Cells(5, 1).Value * trige
f = rng.Cells(6, 1).Value * trigf
g = rng.Cells(7, 1).Value * trigg
h = rng.Cells(8, 1).Value * trigh
i = rng.Cells(9, 1).Value * trigi
j = rng.Cells(10, 1).Value * trigj
k = rng.Cells(11, 1).Value * trigk
l = rng.Cells(12, 1).Value * trigl
m = rng.Cells(13, 1).Value * trigm
n = rng.Cells(14, 1).Value * trign


'MsgBox a & b & c & d

test = a + b + c + d + e + f + g + h + i + j + k + l + m + n

If test = testvalue Then
result = a & " + " & b & " + " & c & " + " & d & " + " & e & " + " & f & " +
" & g & " + " & h & " + " & i & " + " & j & " + " & k & " + " & l & " + " &
m & " + " & n

Dim s As Integer
s = 1

j = 1

ŒThe following while will remove all the ³0¹s² from the expression ...
While j > 0
j = InStr(s, result, "0")

If (InStr(s, result, "10") + 1) <> j Or (InStr(s, result, "10")) = 0 Then

Select Case j
Case Len(result)
result = Mid(result, 1, (Len(result) - 3))
Case 1
result = Mid(result, j + 4, Len(result))
Case 0
'do nothing
Case Else
result = Mid(result, 1, j - 1) + Mid(result, j + 4, Len(result))
End Select

Else
s = j + 2
End If
Wend
If Len(result) <> 1 Then
rng.Cells(pos, 3).Value = result
pos = pos + 1
Else: End If
Else: End If

Next trign: Next trigm: Next trigl: Next trigk: Next trigj: Next trigi
Next trigh: Next trigg: Next trigf: Next trige
Next trigd: Next trigc: Next trigb: Next triga


End Sub

 

[creinmi]

That Macro is great! Is there a simple way to change it in order t
generate a list of the combinations whos sum would fall into
specified range