How can I make Excel or maybe some other program search through 1
different numeric values say A1 thru A14 and list out the combinatio
of cells that add up to exactly equal to a number that I enter into
particular cell?

For example if the numbers were 1-14 in the 14 cells and I enter a 2
in a selected input cell, I want the program to list out the cells tha
add up to 25 like A1,A10,A14 or list the actual values that equal 2
like 1,10,14 in a selected output cell.

Can this be done in Excel? If so please explain how? If not do you kno
of a program that I could purchase that will allow me do this.

Thanks

--
Message posted from http://www.ExcelForum.com

Hi
I suppose that your data are in column A and the particular cell is C
On the cell B1
=if(A1=C$1,"IDEM",""
then do an autofill (click on the right back of the cell and the formula will go on the all column
Then you will just have to look at your column (think to do a sort in data if you have to many data
If you absolutly want a litle box wicht will tell you wicth are the stocks with the same number, you can do that with a macro

Public Sub littlemessage(

Dim rangecell As Rang

For Each cell In Range("A1:" & Range("A1").End(xlDown).Address
If cell.Value = Range("C1").Value The
If rangecell Is Nothing The
Set rangecell = cel
Els
Set rangecell = Union(rangecell, cell
End I
End I
Next cel

if rangecell is not nothing then
MsgBox ("The cell wicht have the same number than the particular one a" & rangecell.Address
end i
End Su

Doug Glancy your awesome buddy!

We're getting somewhere now. I was able to make it work with small
numbers 1 or 2 digits but I do actually have up to 4 digit numbers. It
would run out of memory when trying 4 digit numbers.

But there may be something that could be done to simplify it because it
is getting every possible combination but I only need one combination
that equals to my number. Any one combination is enough.

So is there a way to tell it to stop after it finds the first
combination that equals my number? That would cut the run time down and
memory usage down also if it could stop at that point.

Also I'm using 14 different values to calculate with and here are the
actual number values that I have to use:
8000
4000
2099
1000
800
400
101
100
40
10
8
4
2
1

I have these to use for possible numbers to add together to make #1001
thru #9999 but I only need one combination for each number possible to
create with these given values. There are a lot of numbers between 1001
and 9999 that can't be made with these values but that's okay I just
need all that can be done.

Doug I appreciate the time you spent on this and for someone you don't
even know that's very nice of you. I never dreamed this would be so
complicated and if you can't spend any more time on it that's okay, but
it does look like you're pretty close to whipping this thing.

Thanks Again!


---
Message posted from http://www.ExcelForum.com/

Just one more thing I wanted to add. If 14 numbers are a little too much
for it then maybe it would help make it possible to do if we drop it
down to only 13 or 12 numbers. If that would help then you could drop
the 8000 and maybe the 4000 and if we could make it work with the
remaining 12 numbers from 2099 down to 1 then I could still figure
combinations up to 4565 which would be great also.


---
Message posted from http://www.ExcelForum.com/

I'll see what I can do. What's your timeline?

Doug

"twalls2" wrote in message
...
Just one more thing I wanted to add. If 14 numbers are a little too much
for it then maybe it would help make it possible to do if we drop it
down to only 13 or 12 numbers. If that would help then you could drop
the 8000 and maybe the 4000 and if we could make it work with the
remaining 12 numbers from 2099 down to 1 then I could still figure
combinations up to 4565 which would be great also.


---
Message posted from http://www.ExcelForum.com/

Doug time isn't much of an issue at all. No rush at all.

Thanks again for all your help!

Troy


---
Message posted from http://www.ExcelForum.com/

Here is a non macro approach I posted previously. the size of the numbers
shouldn't have an effect. This did 62 numbers, so well above your
requirement for 14

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

--
Regards,
Tom Ogilvy




twalls2 wrote in message
...
Doug time isn't much of an issue at all. No rush at all.

Thanks again for all your help!

Troy


---
Message posted from http://www.ExcelForum.com/

I responded to your post yesterday through DevDex but it
has yet to materialize. This is at the risk of double
posting.

The trick is to first sort the values in the source range
in ascending order. Then test the combinations against
the target value using nested loops. The loops must be
designed to abort once the combination exceeds the target
value because, due to the ascending order, the
combinations can only increase. Note that this approach
is extremely fast. Also note that we are only conscerned
with combinations as apposed to permuations. For example,
12 + 44 and 44 + 12 are different permuations but are the
same combination.

I developed an extensive macro that does this a while back
which you are welcome to. It was developed for a much
more challenging situation than your example. The time
required to return the results for your example should be
essentially instantaneous.

Be advised that the number of results is extremely
sensitive to 1) the number of elements in the source list,
2) the size of the target value and 3) the maximum number
of elements allowed to sum to the target value. It is
amazingly simple to get a situation where there are many
thousands of results. I developed a filter for the macro
that lets you easily control the above parameters as well
as the maximum numbers of results returned.

Post if you're interested.

Regards,
Greg




-----Original Message-----
How can I make Excel or maybe some other program search
through 14
different numeric values say A1 thru A14 and list out the
combination
of cells that add up to exactly equal to a number that I
enter into a
particular cell?

For example if the numbers were 1-14 in the 14 cells and
I enter a 25
in a selected input cell, I want the program to list out
the cells that
add up to 25 like A1,A10,A14 or list the actual values
that equal 25
like 1,10,14 in a selected output cell.

Can this be done in Excel? If so please explain how? If
not do you know
of a program that I could purchase that will allow me do
this.

Thanks!


---
Message posted from http://www.ExcelForum.com/

.

Greg,

I'd like to see it. One clarification, mine did combinations - I used the
wrong phrase. Still it is slow and I was kinda waiting for the better
answers. It would be very instructive to see yours.

Doug

"Greg Wilson" wrote in message
...
I responded to your post yesterday through DevDex but it
has yet to materialize. This is at the risk of double
posting.

The trick is to first sort the values in the source range
in ascending order. Then test the combinations against
the target value using nested loops. The loops must be
designed to abort once the combination exceeds the target
value because, due to the ascending order, the
combinations can only increase. Note that this approach
is extremely fast. Also note that we are only conscerned
with combinations as apposed to permuations. For example,
12 + 44 and 44 + 12 are different permuations but are the
same combination.

I developed an extensive macro that does this a while back
which you are welcome to. It was developed for a much
more challenging situation than your example. The time
required to return the results for your example should be
essentially instantaneous.

Be advised that the number of results is extremely
sensitive to 1) the number of elements in the source list,
2) the size of the target value and 3) the maximum number
of elements allowed to sum to the target value. It is
amazingly simple to get a situation where there are many
thousands of results. I developed a filter for the macro
that lets you easily control the above parameters as well
as the maximum numbers of results returned.

Post if you're interested.

Regards,
Greg




-----Original Message-----
How can I make Excel or maybe some other program search
through 14
different numeric values say A1 thru A14 and list out the
combination
of cells that add up to exactly equal to a number that I
enter into a
particular cell?

For example if the numbers were 1-14 in the 14 cells and
I enter a 25
in a selected input cell, I want the program to list out
the cells that
add up to 25 like A1,A10,A14 or list the actual values
that equal 25
like 1,10,14 in a selected output cell.

Can this be done in Excel? If so please explain how? If
not do you know
of a program that I could purchase that will allow me do
this.

Thanks!


---
Message posted from http://www.ExcelForum.com/

.

Troy,

You're welcome. Looks like you're getting some better answers now.

Doug

"twalls2" wrote in message
...
Doug time isn't much of an issue at all. No rush at all.

Thanks again for all your help!

Troy


---
Message posted from http://www.ExcelForum.com/

There are actually 3 macros functioning as one totalling
371 lines. This might be considered excessive for posting
to a news group (???). In that the OP has indicated that
he was willing to pay for such a utility if available in
my opinion proves that his need is serious and therefore
deserves this consideration. You have indicated interest
as well. Before posting, I would like your opinion and/or
other opinions as to whether this is excessive.

A large part of the code involves creating on the fly a UF
that allows you to input the target value as well as to
select filter criteria. Therefore, it's not as big and
ugly as it sounds.

Regards,
Greg




-----Original Message-----
Greg,

I'd like to see it. One clarification, mine did
combinations - I used the
wrong phrase. Still it is slow and I was kinda waiting
for the better
answers. It would be very instructive to see yours.

Doug

"Greg Wilson" wrote
in message
...
I responded to your post yesterday through DevDex but it
has yet to materialize. This is at the risk of double
posting.

The trick is to first sort the values in the source
range
in ascending order. Then test the combinations against
the target value using nested loops. The loops must be
designed to abort once the combination exceeds the
target
value because, due to the ascending order, the
combinations can only increase. Note that this approach
is extremely fast. Also note that we are only
conscerned
with combinations as apposed to permuations. For
example,
12 + 44 and 44 + 12 are different permuations but are
the
same combination.

I developed an extensive macro that does this a while
back
which you are welcome to. It was developed for a much
more challenging situation than your example. The time
required to return the results for your example should
be
essentially instantaneous.

Be advised that the number of results is extremely
sensitive to 1) the number of elements in the source
list,
2) the size of the target value and 3) the maximum
number
of elements allowed to sum to the target value. It is
amazingly simple to get a situation where there are many
thousands of results. I developed a filter for the
macro
that lets you easily control the above parameters as
well
as the maximum numbers of results returned.

Post if you're interested.

Regards,
Greg




-----Original Message-----
How can I make Excel or maybe some other program search
through 14
different numeric values say A1 thru A14 and list out
the
combination
of cells that add up to exactly equal to a number that
I
enter into a
particular cell?

For example if the numbers were 1-14 in the 14 cells
and
I enter a 25
in a selected input cell, I want the program to list
out
the cells that
add up to 25 like A1,A10,A14 or list the actual values
that equal 25
like 1,10,14 in a selected output cell.

Can this be done in Excel? If so please explain how? If
not do you know
of a program that I could purchase that will allow me
do
this.

Thanks!


---
Message posted from http://www.ExcelForum.com/

.



.

Very interesting, as always. You are a font of knowledge, Tom.

Doug

"Tom Ogilvy" wrote in message
...
Here is a non macro approach I posted previously. the size of the numbers
shouldn't have an effect. This did 62 numbers, so well above your
requirement for 14


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

--
Regards,
Tom Ogilvy




twalls2 wrote in message
...
Doug time isn't much of an issue at all. No rush at all.

Thanks again for all your help!

Troy


---
Message posted from http://www.ExcelForum.com/

Put your numbers in Column B, starting in B1
Put the number to sum to in A1
Run TestBldBin

this will list all combinations in columns going to the right - obviously it
runs out of room at 256. If nothing is shown, there are no combinations
(for example 9999 with the sample 14 numbers).

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
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

--
Regards,
Tom Ogilvy


Doug Glancy wrote in message
...
Greg,

I'd like to see it. One clarification, mine did combinations - I used the
wrong phrase. Still it is slow and I was kinda waiting for the better
answers. It would be very instructive to see yours.

Doug

"Greg Wilson" wrote in message
...
I responded to your post yesterday through DevDex but it
has yet to materialize. This is at the risk of double
posting.

The trick is to first sort the values in the source range
in ascending order. Then test the combinations against
the target value using nested loops. The loops must be
designed to abort once the combination exceeds the target
value because, due to the ascending order, the
combinations can only increase. Note that this approach
is extremely fast. Also note that we are only conscerned
with combinations as apposed to permuations. For example,
12 + 44 and 44 + 12 are different permuations but are the
same combination.

I developed an extensive macro that does this a while back
which you are welcome to. It was developed for a much
more challenging situation than your example. The time
required to return the results for your example should be
essentially instantaneous.

Be advised that the number of results is extremely
sensitive to 1) the number of elements in the source list,
2) the size of the target value and 3) the maximum number
of elements allowed to sum to the target value. It is
amazingly simple to get a situation where there are many
thousands of results. I developed a filter for the macro
that lets you easily control the above parameters as well
as the maximum numbers of results returned.

Post if you're interested.

Regards,
Greg




-----Original Message-----
How can I make Excel or maybe some other program search
through 14
different numeric values say A1 thru A14 and list out the
combination
of cells that add up to exactly equal to a number that I
enter into a
particular cell?

For example if the numbers were 1-14 in the 14 cells and
I enter a 25
in a selected input cell, I want the program to list out
the cells that
add up to 25 like A1,A10,A14 or list the actual values
that equal 25
like 1,10,14 in a selected output cell.

Can this be done in Excel? If so please explain how? If
not do you know
of a program that I could purchase that will allow me do
this.

Thanks!


---
Message posted from http://www.ExcelForum.com/

.

Greg,

I don't know if it breaches any etiquette. 400 lines is a very small
percentage of what passes through this group on a daily basis, so I'd guess
it's okay. It's just a curiosity on my part, although it took me more time
than I'd care to admit to write what I did, so, like I said, it would be
educational.

I appreciate your willingness to share it but understand if you decide
otherwise.

Doug

"Greg Wilson" wrote in message
...
There are actually 3 macros functioning as one totalling
371 lines. This might be considered excessive for posting
to a news group (???). In that the OP has indicated that
he was willing to pay for such a utility if available in
my opinion proves that his need is serious and therefore
deserves this consideration. You have indicated interest
as well. Before posting, I would like your opinion and/or
other opinions as to whether this is excessive.

A large part of the code involves creating on the fly a UF
that allows you to input the target value as well as to
select filter criteria. Therefore, it's not as big and
ugly as it sounds.

Regards,
Greg




-----Original Message-----
Greg,

I'd like to see it. One clarification, mine did
combinations - I used the
wrong phrase. Still it is slow and I was kinda waiting
for the better
answers. It would be very instructive to see yours.

Doug

"Greg Wilson" wrote
in message
...
I responded to your post yesterday through DevDex but it
has yet to materialize. This is at the risk of double
posting.

The trick is to first sort the values in the source
range
in ascending order. Then test the combinations against
the target value using nested loops. The loops must be
designed to abort once the combination exceeds the
target
value because, due to the ascending order, the
combinations can only increase. Note that this approach
is extremely fast. Also note that we are only
conscerned
with combinations as apposed to permuations. For
example,
12 + 44 and 44 + 12 are different permuations but are
the
same combination.

I developed an extensive macro that does this a while
back
which you are welcome to. It was developed for a much
more challenging situation than your example. The time
required to return the results for your example should
be
essentially instantaneous.

Be advised that the number of results is extremely
sensitive to 1) the number of elements in the source
list,
2) the size of the target value and 3) the maximum
number
of elements allowed to sum to the target value. It is
amazingly simple to get a situation where there are many
thousands of results. I developed a filter for the
macro
that lets you easily control the above parameters as
well
as the maximum numbers of results returned.

Post if you're interested.

Regards,
Greg




-----Original Message-----
How can I make Excel or maybe some other program search
through 14
different numeric values say A1 thru A14 and list out
the
combination
of cells that add up to exactly equal to a number that
I
enter into a
particular cell?

For example if the numbers were 1-14 in the 14 cells
and
I enter a 25
in a selected input cell, I want the program to list
out
the cells that
add up to 25 like A1,A10,A14 or list the actual values
that equal 25
like 1,10,14 in a selected output cell.

Can this be done in Excel? If so please explain how? If
not do you know
of a program that I could purchase that will allow me
do
this.

Thanks!


---
Message posted from http://www.ExcelForum.com/

.



.

Greg, if the offer to see your macro is still available i'd be very
interested in seeing it if i may. (Would you need an email address for
this? Let me know if thats the case)

In the meantime, can anyone help with this related query?

I have been trying to create a macro that will do something very
similar but with 6,7 or 8 digit numbers. The number i want to match to
is also 6-8 digits. The actual numbers of solutions willbe quite small
(usually less than 10) but due to the limits on excel i can't use the
above method. Does anyone have any ideas how i can get around this
problem?

If this sounds to vague to anyone here's a short but more detailed
example of what i mean below:


Basically i need to know which of the 8 values (the no.of values will
range from 5-50+!!!) in column A make up the values in Column B.
(Please note: the numbers are simply examples, they will never be the
same on 2 different occasions!)

Column A: Column B:
540,250 2,546,800 (the sum of the 1st, 3rd, 5th no.)
8,300,120 9,109,120 (the sum of the 2nd and 8th)
7,500 50 (the 6th no.)
123,500 598,500 (the sum of the 4th and 7th)
1,999,050
50
475,000
809,000


I have both the sets of numbers - its just very tricky to link them
manually sometimes! If anyone can help me solve this i'll be extremely
grateful.


---
Message posted from http://www.ExcelForum.com/

My code solved all your test values.

--
Regards,
Tom Ogilvy

ian123 wrote in message
...
Greg, if the offer to see your macro is still available i'd be very
interested in seeing it if i may. (Would you need an email address for
this? Let me know if thats the case)

In the meantime, can anyone help with this related query?

I have been trying to create a macro that will do something very
similar but with 6,7 or 8 digit numbers. The number i want to match to
is also 6-8 digits. The actual numbers of solutions willbe quite small
(usually less than 10) but due to the limits on excel i can't use the
above method. Does anyone have any ideas how i can get around this
problem?

If this sounds to vague to anyone here's a short but more detailed
example of what i mean below:


Basically i need to know which of the 8 values (the no.of values will
range from 5-50+!!!) in column A make up the values in Column B.
(Please note: the numbers are simply examples, they will never be the
same on 2 different occasions!)

Column A: Column B:
540,250 2,546,800 (the sum of the 1st, 3rd, 5th no.)
8,300,120 9,109,120 (the sum of the 2nd and 8th)
7,500 50 (the 6th no.)
123,500 598,500 (the sum of the 4th and 7th)
1,999,050
50
475,000
809,000


I have both the sets of numbers - its just very tricky to link them
manually sometimes! If anyone can help me solve this i'll be extremely
grateful.


---
Message posted from http://www.ExcelForum.com/

Doug,

The complete code follows. Unfortunately, I can't post
through DevDex which gives me more horizontal space. The
code will be severely effected by word wrap errors. You'll
have to fix it. I had to remove all indentation to limit
word wrap.

Note:- You must first select the cells containing the
source values before running the macro. The on-the-fly UF
will allow you to input the target value and select filter
criteria. An oversight on my part is that the code does
not advise the user to first select the source data. You
might consider fixing this. It was originally designed
for decimal values such as currency. Try it under a
situation more challenging than just integers.

I use John Walkenbauch's BubbleSort procedure to sort the
array made of the selected numbers. The sorting is done
in memory - the original data is left alone. Please
maintain the credit to John in the code. Please advise of
the outcome.

Hope it goes well.

Regards,
Greg


Option Explicit
Option Base 1
Public Target As Double
Public Tol As Single
Public MaxElem As Integer
Public MaxResults As Integer

Dim List() As Variant, CumList() As Variant, DynList As
Variant
Dim SumVal As Double
Dim num As Integer, RefCell As Range
Dim a As Integer, b As Integer, C As Integer, d As Integer
Dim e As Integer, f As Integer, g As Integer, h As Integer
Dim i As Integer, j As Integer

Sub GW_FindCombinations()
Dim Prompt As String, Title As String, Style As Integer
Dim Resp As Integer, i As Integer, Cell As Range

Call MakeUF 'Create and call user form to get Target value
and filter criteria.

If Target = 0 Then Exit Sub

SumVal = 0
a = 0: b = 0: C = 0: d = 0: e = 0: f = 0: g = 0: h = 0: i
= 0: j = 0

'***** Establish number of elements in list and dimention
arrays *****
num = Selection.Cells.Count + 1 'Additional element in
list to be assigned value of zero.
ReDim List(num)
ReDim CumList(num)

'***** Exit if non-numeric value found in list else assign
selected cell values to list *****
i = 1 'Assign i an initial value of 1 so first value
assigned to array is element 2.
List(1) = 0
CumList(1) = 0
For Each Cell In Selection.Cells
If Not IsNumeric(Cell) Then
MsgBox "Error: Non-numeric value found in the selected
list. " & _
"Only numeric values allowed in list. ",
vbCritical, "Combinations Analysis"
Exit Sub
Else
i = i + 1
List(i) = Cell 'Populate List array with selected elements
leaving first element (item 0) equal to zero.
End If
Next

'***** Sort list in ascending order *****
Call BubbleSort(List())
'***** Establish CumList values as cumulative values of
selected cells *****
For i = 2 To num
CumList(i) = CumList(i - 1) + List(i)
Next

If Target = 0 Then Exit Sub
'***** Calculate maximum number of elements summed
required to exceed Target value *****
For i = 1 To num
If CumList(i) Target + Tol Then Exit For
Next
'***** Prompt for option to specify max. number of
elements required to sum to Target value *****

If i - 2 10 Then
Prompt = "The macro has a limit of 10 elements that can
sum to the target value. It has been determined " & _
"that more than 10 elements from the currently selected
list can sum to " & Target & ". Therefore, you must " & _
"reduce the number of elements in the list, specify a
lower target value or accept an incomplete list of " & _
"results." & vbCr & vbCr & _
"Continue ???"
Style = vbQuestion + vbYesNo
Title = "GW_FindCombinations"
Resp = MsgBox(Prompt, Style, Title)
If Resp = vbNo Then Exit Sub
End If

If MaxElem = 0 Then
Exit Sub
Else
'Format column to right of selection to receive results.
Set RefCell = ActiveCell.Offset(, Selection.Columns.Count)
RefCell.EntireColumn.Insert
Set RefCell = RefCell.Offset(, -1)
With RefCell
..EntireColumn.HorizontalAlignment = 2
..EntireColumn.IndentLevel = 1
..Font.Bold = True
..Value = "Results for Target = " & Target
..Columns.AutoFit
End With
End If
Call MainProc

End Sub
Private Sub MainProc()
Dim z As Integer, NumElem As Integer, NumResults As Integer
Dim Nb As Integer, Nc As Integer, Nd As Integer, Ne As
Integer
Dim Nf As Integer, Ng As Integer, Nh As Integer, Ni As
Integer
Dim Nj As Integer, StartTime As Date, EndTime As Date,
Duration As Variant
Dim Prompt1 As String, Prompt2 As String
Dim Title As String, Style As Integer, Txt As String

StartTime = Now
On Error Resume Next
Application.ScreenUpdating = False

Nb = 0: Nc = 0: Nd = 0: Ne = 0: Nf = 0: Ng = 0: Nh = 0: Ni
= 0: Nj = 0
NumElem = 1

For a = 1 To num: Call CalcSumVal
If SumVal Target + Tol Then Exit For
For b = a + Nb To num: Call CalcSumVal
If SumVal Target + Tol Then
b = a + 2: C = a + 3: d = a + 4: e = a + 5: f = a + 6: g =
a + 7: h = a + 8: i = a + 9: j = a + 10
Exit For
End If
For C = b + Nc To num: Call CalcSumVal
If SumVal Target + Tol Then
C = b + 2: d = b + 3: e = b + 4: f = b + 5: g = b + 6: h =
b + 7: i = b + 8: j = b + 9
Exit For
End If
For d = C + Nd To num: Call CalcSumVal
If SumVal Target + Tol Then
d = C + 2: e = C + 3: f = C + 4: g = C + 5: h = C + 6: i =
C + 7: j = C + 8
Exit For
End If
For e = d + Ne To num: Call CalcSumVal
If SumVal Target + Tol Then
e = d + 2: f = d + 3: g = d + 4: h = d + 5: i = d + 6: j =
d + 7
Exit For
End If
For f = e + Nf To num: Call CalcSumVal
If SumVal Target + Tol Then
f = e + 2: g = e + 3: h = e + 4: i = e + 5: j = e + 6
Exit For
End If
For g = f + Ng To num: Call CalcSumVal
If SumVal Target + Tol Then
g = f + 2: h = f + 3: i = f + 4: j = f + 5
Exit For
End If
For h = g + Nh To num: Call CalcSumVal
If SumVal Target + Tol Then
h = g + 2: i = g + 3: j = g + 4
Exit For
End If
For i = h + Ni To num: Call CalcSumVal
If SumVal Target + Tol Then
i = h + 2: j = h + 3
Exit For
End If
For j = i + Nj To num: Call CalcSumVal
If SumVal Target + Tol Then
j = i + 2
Exit For
End If

If NumElem MaxElem Then GoTo EndMsg

If Abs(SumVal - Target) <= Tol Then

For z = 1 To 9
If DynList(z) 0 Then
Txt = Txt & DynList(z) & " + "
End If
Next
Txt = Txt & DynList(10) & " = " & SumVal

Set RefCell = RefCell.Offset(1)
RefCell.Value = Txt
Txt = ""
NumResults = NumResults + 1
If NumResults = MaxResults Then
MsgBox "Limit of " & MaxResults & " results reached.
Macro aborted. ", _
vbExclamation, "Combinations Analysis"
GoTo EndMsg
End If

End If

Next j: Nj = 1: NumElem = 2
Next i: Ni = 1: NumElem = 3
Next h: Nh = 1: NumElem = 4
Next g: Ng = 1: NumElem = 5
Next f: Nf = 1: NumElem = 6
Next e: Ne = 1: NumElem = 7
Next d: Nd = 1: NumElem = 8
Next C: Nc = 1: NumElem = 9
Next b: Nb = 1: NumElem = 10
Next a

EndMsg:

RefCell.EntireColumn.AutoFit

EndTime = Now
Duration = Format(EndTime - StartTime, "hh:mm:ss")
If NumResults = 0 Then
Prompt1 = "Sorry, no combinations were found that sum to "
& Target & ". " & vbCr & vbCr
Prompt2 = "Duration = " & Duration
Else
Prompt1 = "Analysis complete !!!" & vbCr & vbCr
Prompt2 = "Duration = " & Duration & vbCr & _
"Number of combinations found that sum to " & Target & "
= " & NumResults & " "
End If

Application.ScreenUpdating = True
Style = vbInformation
Title = "GW_FindCombinations"
MsgBox Prompt1 & Prompt2, Style, Title

End Sub

Private Sub CalcSumVal()
DynList = Array(List(a), List(b), List(C), List(d), List
(e), List(f), List(g), List(h), _
List(i), List(j))
SumVal = Application.Sum(DynList)
End Sub
Private Sub BubbleSort(List())
'***** John Walkenback's BubbleSort procedure *****
'***** Do not remove above credit to John in your code
*****
Dim First As Integer, Last As Integer
Dim i As Integer, j As Integer
Dim Temp As Variant
First = LBound(List)
Last = UBound(List)
For i = First To Last - 1
For j = i + 1 To Last
If List(i) List(j) Then
Temp = List(j)
List(j) = List(i)
List(i) = Temp
End If
Next j
Next i
End Sub
Private Sub MakeUF()
Dim UF As Object, Frame As Object, Ctrl As Object
Dim i As Integer, CM As Object, Line As Integer, Code As
String

Set UF = Application.VBE.ActiveVBProject.VBComponents.Add
(3)
With UF
..Properties("Height") = 175
..Properties("Width") = 160
..Properties("Caption") = "GW_FindCombinations"
End With
Set Ctrl = UF.Designer.Controls.Add("Forms.Label.1")
With Ctrl
..Width = 60
..Height = 18
..Top = 12
..Left = 10
..Caption = "Target value"
End With
Set Ctrl = UF.Designer.Controls.Add("Forms.Textbox.1")
With Ctrl
..Width = 40
..Height = 16
..Top = 10
..Left = 80
..Font.Size = 8
End With
Set Frame = UF.Designer.Controls.Add("Forms.Frame.1")
With Frame
..Width = 145
..Height = 90
..Top = 30
..Left = 5
..Caption = "Filter"
End With
For i = 1 To 5 Step 2
Set Ctrl = Frame.Controls.Add("Forms.Label.1")
With Ctrl
..Width = 70
..Height = 18
..Top = i * 12 + 2
..Left = 5
Select Case i
Case 1
..Caption = "Tolerance (±) Pct"
Case 3
..Caption = "Max. Elements"
Case 5
..Caption = "Max. Results"
End Select
End With
Next
For i = 1 To 5 Step 2
Set Ctrl = Frame.Controls.Add("Forms.Textbox.1")
With Ctrl
..Width = 35
..Height = 16
..Top = i * 12
..Left = 80
..Font.Size = 8
Select Case i
Case 1
..Text = "0.00"
Case 3
..Text = "10"
Case 5
..Text = "1000"
End Select
End With
Next

For i = 1 To 5 Step 2
Set Ctrl = Frame.Controls.Add("Forms.Spinbutton.1")
With Ctrl
..Orientation = 0
..Width = 15
..Height = 16
..Top = i * 12
..Left = 120
End With
Next

For i = 0 To 1
Set Ctrl = UF.Designer.Controls.Add
("Forms.CommandButton.1")
With Ctrl
..Width = 60
..Height = 18
..Top = 130
..Left = 12 + i * 70
If i = 0 Then .Caption = "OK" Else .Caption = "Abort"
End With
Next
Set CM = UF.CodeModule
With CM
Line = CM.CountOfLines
Code = "Private Sub SpinButton1_SpinUp()"
Code = Code & vbCr & "With TextBox2"
Code = Code & vbCr & ".Text = WorksheetFunction.Min(Val
(.Text) + 0.01, 5)"
Code = Code & vbCr & "End With"
Code = Code & vbCr & "End Sub"
Code = Code & vbCr & "Private Sub SpinButton1_SpinDown()"
Code = Code & vbCr & "With TextBox2"
Code = Code & vbCr & ".Text = WorksheetFunction.Max(Val
(.Text) - 0.01, 0)"
Code = Code & vbCr & "End With"
Code = Code & vbCr & "End Sub"
Code = Code & vbCr & "Private Sub SpinButton2_SpinUp()"
Code = Code & vbCr & "With TextBox3"
Code = Code & vbCr & ".Text = WorksheetFunction.Min(Val
(.Text) + 1, 10)"
Code = Code & vbCr & "End With"
Code = Code & vbCr & "End Sub"
Code = Code & vbCr & "Private Sub SpinButton2_SpinDown()"
Code = Code & vbCr & "With TextBox3"
Code = Code & vbCr & ".Text = WorksheetFunction.Max(Val
(.Text) - 1, 1)"
Code = Code & vbCr & "End With"
Code = Code & vbCr & "End Sub"
Code = Code & vbCr & "Private Sub SpinButton3_SpinUp()"
Code = Code & vbCr & "With TextBox4"
Code = Code & vbCr & ".Text = WorksheetFunction.Min(Val
(.Text) + 1, 1000)"
Code = Code & vbCr & "End With"
Code = Code & vbCr & "End Sub"
Code = Code & vbCr & "Private Sub SpinButton3_SpinDown()"
Code = Code & vbCr & "With TextBox4"
Code = Code & vbCr & ".Text = WorksheetFunction.Max(Val
(.Text) - 1, 1)"
Code = Code & vbCr & "End With"
Code = Code & vbCr & "End Sub"
Code = Code & vbCr & "Private Sub CommandButton1_Click()"
Code = Code & vbCr & "Target = Val(TextBox1.Text)"
Code = Code & vbCr & "Tol = TextBox1.Value * Val
(TextBox2.Text) / 100"
Code = Code & vbCr & "MaxElem = Val(TextBox3.Text)"
Code = Code & vbCr & "MaxResults = Val(TextBox4.Text)"
Code = Code & vbCr & "Unload Me"
Code = Code & vbCr & "End Sub"
Code = Code & vbCr & "Private Sub CommandButton2_Click()"
Code = Code & vbCr & "Unload Me"
Code = Code & vbCr & "End Sub"
CM.InsertLines Line + 1, Code
End With

VBA.UserForms.Add(UF.Name).Show
ThisWorkbook.VBProject.VBComponents.Remove UF
End Sub

Thanks Greg.

I'll reconstitute and try it.

Doug

"Greg Wilson" wrote in message
...
Doug,

The complete code follows. Unfortunately, I can't post
through DevDex which gives me more horizontal space. The
code will be severely effected by word wrap errors. You'll
have to fix it. I had to remove all indentation to limit
word wrap.

Note:- You must first select the cells containing the
source values before running the macro. The on-the-fly UF
will allow you to input the target value and select filter
criteria. An oversight on my part is that the code does
not advise the user to first select the source data. You
might consider fixing this. It was originally designed
for decimal values such as currency. Try it under a
situation more challenging than just integers.

I use John Walkenbauch's BubbleSort procedure to sort the
array made of the selected numbers. The sorting is done
in memory - the original data is left alone. Please
maintain the credit to John in the code. Please advise of
the outcome.

Hope it goes well.

Regards,
Greg


Option Explicit
Option Base 1
Public Target As Double
Public Tol As Single
Public MaxElem As Integer
Public MaxResults As Integer

Dim List() As Variant, CumList() As Variant, DynList As
Variant
Dim SumVal As Double
Dim num As Integer, RefCell As Range
Dim a As Integer, b As Integer, C As Integer, d As Integer
Dim e As Integer, f As Integer, g As Integer, h As Integer
Dim i As Integer, j As Integer

Sub GW_FindCombinations()
Dim Prompt As String, Title As String, Style As Integer
Dim Resp As Integer, i As Integer, Cell As Range

Call MakeUF 'Create and call user form to get Target value
and filter criteria.

If Target = 0 Then Exit Sub

SumVal = 0
a = 0: b = 0: C = 0: d = 0: e = 0: f = 0: g = 0: h = 0: i
= 0: j = 0

'***** Establish number of elements in list and dimention
arrays *****
num = Selection.Cells.Count + 1 'Additional element in
list to be assigned value of zero.
ReDim List(num)
ReDim CumList(num)

'***** Exit if non-numeric value found in list else assign
selected cell values to list *****
i = 1 'Assign i an initial value of 1 so first value
assigned to array is element 2.
List(1) = 0
CumList(1) = 0
For Each Cell In Selection.Cells
If Not IsNumeric(Cell) Then
MsgBox "Error: Non-numeric value found in the selected
list. " & _
"Only numeric values allowed in list. ",
vbCritical, "Combinations Analysis"
Exit Sub
Else
i = i + 1
List(i) = Cell 'Populate List array with selected elements
leaving first element (item 0) equal to zero.
End If
Next

'***** Sort list in ascending order *****
Call BubbleSort(List())
'***** Establish CumList values as cumulative values of
selected cells *****
For i = 2 To num
CumList(i) = CumList(i - 1) + List(i)
Next

If Target = 0 Then Exit Sub
'***** Calculate maximum number of elements summed
required to exceed Target value *****
For i = 1 To num
If CumList(i) Target + Tol Then Exit For
Next
'***** Prompt for option to specify max. number of
elements required to sum to Target value *****

If i - 2 10 Then
Prompt = "The macro has a limit of 10 elements that can
sum to the target value. It has been determined " & _
"that more than 10 elements from the currently selected
list can sum to " & Target & ". Therefore, you must " & _
"reduce the number of elements in the list, specify a
lower target value or accept an incomplete list of " & _
"results." & vbCr & vbCr & _
"Continue ???"
Style = vbQuestion + vbYesNo
Title = "GW_FindCombinations"
Resp = MsgBox(Prompt, Style, Title)
If Resp = vbNo Then Exit Sub
End If

If MaxElem = 0 Then
Exit Sub
Else
'Format column to right of selection to receive results.
Set RefCell = ActiveCell.Offset(, Selection.Columns.Count)
RefCell.EntireColumn.Insert
Set RefCell = RefCell.Offset(, -1)
With RefCell
..EntireColumn.HorizontalAlignment = 2
..EntireColumn.IndentLevel = 1
..Font.Bold = True
..Value = "Results for Target = " & Target
..Columns.AutoFit
End With
End If
Call MainProc

End Sub
Private Sub MainProc()
Dim z As Integer, NumElem As Integer, NumResults As Integer
Dim Nb As Integer, Nc As Integer, Nd As Integer, Ne As
Integer
Dim Nf As Integer, Ng As Integer, Nh As Integer, Ni As
Integer
Dim Nj As Integer, StartTime As Date, EndTime As Date,
Duration As Variant
Dim Prompt1 As String, Prompt2 As String
Dim Title As String, Style As Integer, Txt As String

StartTime = Now
On Error Resume Next
Application.ScreenUpdating = False

Nb = 0: Nc = 0: Nd = 0: Ne = 0: Nf = 0: Ng = 0: Nh = 0: Ni
= 0: Nj = 0
NumElem = 1

For a = 1 To num: Call CalcSumVal
If SumVal Target + Tol Then Exit For
For b = a + Nb To num: Call CalcSumVal
If SumVal Target + Tol Then
b = a + 2: C = a + 3: d = a + 4: e = a + 5: f = a + 6: g =
a + 7: h = a + 8: i = a + 9: j = a + 10
Exit For
End If
For C = b + Nc To num: Call CalcSumVal
If SumVal Target + Tol Then
C = b + 2: d = b + 3: e = b + 4: f = b + 5: g = b + 6: h =
b + 7: i = b + 8: j = b + 9
Exit For
End If
For d = C + Nd To num: Call CalcSumVal
If SumVal Target + Tol Then
d = C + 2: e = C + 3: f = C + 4: g = C + 5: h = C + 6: i =
C + 7: j = C + 8
Exit For
End If
For e = d + Ne To num: Call CalcSumVal
If SumVal Target + Tol Then
e = d + 2: f = d + 3: g = d + 4: h = d + 5: i = d + 6: j =
d + 7
Exit For
End If
For f = e + Nf To num: Call CalcSumVal
If SumVal Target + Tol Then
f = e + 2: g = e + 3: h = e + 4: i = e + 5: j = e + 6
Exit For
End If
For g = f + Ng To num: Call CalcSumVal
If SumVal Target + Tol Then
g = f + 2: h = f + 3: i = f + 4: j = f + 5
Exit For
End If
For h = g + Nh To num: Call CalcSumVal
If SumVal Target + Tol Then
h = g + 2: i = g + 3: j = g + 4
Exit For
End If
For i = h + Ni To num: Call CalcSumVal
If SumVal Target + Tol Then
i = h + 2: j = h + 3
Exit For
End If
For j = i + Nj To num: Call CalcSumVal
If SumVal Target + Tol Then
j = i + 2
Exit For
End If

If NumElem MaxElem Then GoTo EndMsg

If Abs(SumVal - Target) <= Tol Then

For z = 1 To 9
If DynList(z) 0 Then
Txt = Txt & DynList(z) & " + "
End If
Next
Txt = Txt & DynList(10) & " = " & SumVal

Set RefCell = RefCell.Offset(1)
RefCell.Value = Txt
Txt = ""
NumResults = NumResults + 1
If NumResults = MaxResults Then
MsgBox "Limit of " & MaxResults & " results reached.
Macro aborted. ", _
vbExclamation, "Combinations Analysis"
GoTo EndMsg
End If

End If

Next j: Nj = 1: NumElem = 2
Next i: Ni = 1: NumElem = 3
Next h: Nh = 1: NumElem = 4
Next g: Ng = 1: NumElem = 5
Next f: Nf = 1: NumElem = 6
Next e: Ne = 1: NumElem = 7
Next d: Nd = 1: NumElem = 8
Next C: Nc = 1: NumElem = 9
Next b: Nb = 1: NumElem = 10
Next a

EndMsg:

RefCell.EntireColumn.AutoFit

EndTime = Now
Duration = Format(EndTime - StartTime, "hh:mm:ss")
If NumResults = 0 Then
Prompt1 = "Sorry, no combinations were found that sum to "
& Target & ". " & vbCr & vbCr
Prompt2 = "Duration = " & Duration
Else
Prompt1 = "Analysis complete !!!" & vbCr & vbCr
Prompt2 = "Duration = " & Duration & vbCr & _
"Number of combinations found that sum to " & Target & "
= " & NumResults & " "
End If

Application.ScreenUpdating = True
Style = vbInformation
Title = "GW_FindCombinations"
MsgBox Prompt1 & Prompt2, Style, Title

End Sub

Private Sub CalcSumVal()
DynList = Array(List(a), List(b), List(C), List(d), List
(e), List(f), List(g), List(h), _
List(i), List(j))
SumVal = Application.Sum(DynList)
End Sub
Private Sub BubbleSort(List())
'***** John Walkenback's BubbleSort procedure *****
'***** Do not remove above credit to John in your code
*****
Dim First As Integer, Last As Integer
Dim i As Integer, j As Integer
Dim Temp As Variant
First = LBound(List)
Last = UBound(List)
For i = First To Last - 1
For j = i + 1 To Last
If List(i) List(j) Then
Temp = List(j)
List(j) = List(i)
List(i) = Temp
End If
Next j
Next i
End Sub
Private Sub MakeUF()
Dim UF As Object, Frame As Object, Ctrl As Object
Dim i As Integer, CM As Object, Line As Integer, Code As
String

Set UF = Application.VBE.ActiveVBProject.VBComponents.Add
(3)
With UF
..Properties("Height") = 175
..Properties("Width") = 160
..Properties("Caption") = "GW_FindCombinations"
End With
Set Ctrl = UF.Designer.Controls.Add("Forms.Label.1")
With Ctrl
..Width = 60
..Height = 18
..Top = 12
..Left = 10
..Caption = "Target value"
End With
Set Ctrl = UF.Designer.Controls.Add("Forms.Textbox.1")
With Ctrl
..Width = 40
..Height = 16
..Top = 10
..Left = 80
..Font.Size = 8
End With
Set Frame = UF.Designer.Controls.Add("Forms.Frame.1")
With Frame
..Width = 145
..Height = 90
..Top = 30
..Left = 5
..Caption = "Filter"
End With
For i = 1 To 5 Step 2
Set Ctrl = Frame.Controls.Add("Forms.Label.1")
With Ctrl
..Width = 70
..Height = 18
..Top = i * 12 + 2
..Left = 5
Select Case i
Case 1
..Caption = "Tolerance (±) Pct"
Case 3
..Caption = "Max. Elements"
Case 5
..Caption = "Max. Results"
End Select
End With
Next
For i = 1 To 5 Step 2
Set Ctrl = Frame.Controls.Add("Forms.Textbox.1")
With Ctrl
..Width = 35
..Height = 16
..Top = i * 12
..Left = 80
..Font.Size = 8
Select Case i
Case 1
..Text = "0.00"
Case 3
..Text = "10"
Case 5
..Text = "1000"
End Select
End With
Next

For i = 1 To 5 Step 2
Set Ctrl = Frame.Controls.Add("Forms.Spinbutton.1")
With Ctrl
..Orientation = 0
..Width = 15
..Height = 16
..Top = i * 12
..Left = 120
End With
Next

For i = 0 To 1
Set Ctrl = UF.Designer.Controls.Add
("Forms.CommandButton.1")
With Ctrl
..Width = 60
..Height = 18
..Top = 130
..Left = 12 + i * 70
If i = 0 Then .Caption = "OK" Else .Caption = "Abort"
End With
Next
Set CM = UF.CodeModule
With CM
Line = CM.CountOfLines
Code = "Private Sub SpinButton1_SpinUp()"
Code = Code & vbCr & "With TextBox2"
Code = Code & vbCr & ".Text = WorksheetFunction.Min(Val
(.Text) + 0.01, 5)"
Code = Code & vbCr & "End With"
Code = Code & vbCr & "End Sub"
Code = Code & vbCr & "Private Sub SpinButton1_SpinDown()"
Code = Code & vbCr & "With TextBox2"
Code = Code & vbCr & ".Text = WorksheetFunction.Max(Val
(.Text) - 0.01, 0)"
Code = Code & vbCr & "End With"
Code = Code & vbCr & "End Sub"
Code = Code & vbCr & "Private Sub SpinButton2_SpinUp()"
Code = Code & vbCr & "With TextBox3"
Code = Code & vbCr & ".Text = WorksheetFunction.Min(Val
(.Text) + 1, 10)"
Code = Code & vbCr & "End With"
Code = Code & vbCr & "End Sub"
Code = Code & vbCr & "Private Sub SpinButton2_SpinDown()"
Code = Code & vbCr & "With TextBox3"
Code = Code & vbCr & ".Text = WorksheetFunction.Max(Val
(.Text) - 1, 1)"
Code = Code & vbCr & "End With"
Code = Code & vbCr & "End Sub"
Code = Code & vbCr & "Private Sub SpinButton3_SpinUp()"
Code = Code & vbCr & "With TextBox4"
Code = Code & vbCr & ".Text = WorksheetFunction.Min(Val
(.Text) + 1, 1000)"
Code = Code & vbCr & "End With"
Code = Code & vbCr & "End Sub"
Code = Code & vbCr & "Private Sub SpinButton3_SpinDown()"
Code = Code & vbCr & "With TextBox4"
Code = Code & vbCr & ".Text = WorksheetFunction.Max(Val
(.Text) - 1, 1)"
Code = Code & vbCr & "End With"
Code = Code & vbCr & "End Sub"
Code = Code & vbCr & "Private Sub CommandButton1_Click()"
Code = Code & vbCr & "Target = Val(TextBox1.Text)"
Code = Code & vbCr & "Tol = TextBox1.Value * Val
(TextBox2.Text) / 100"
Code = Code & vbCr & "MaxElem = Val(TextBox3.Text)"
Code = Code & vbCr & "MaxResults = Val(TextBox4.Text)"
Code = Code & vbCr & "Unload Me"
Code = Code & vbCr & "End Sub"
Code = Code & vbCr & "Private Sub CommandButton2_Click()"
Code = Code & vbCr & "Unload Me"
Code = Code & vbCr & "End Sub"
CM.InsertLines Line + 1, Code
End With

VBA.UserForms.Add(UF.Name).Show
ThisWorkbook.VBProject.VBComponents.Remove UF
End Sub

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

--
Message posted from http://www.ExcelForum.com

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


"Tom Ogilvy" wrote in message
...
Put your numbers in Column B, starting in B1
Put the number to sum to in A1
Run TestBldBin

this will list all combinations in columns going to the right - obviously
it
runs out of room at 256. If nothing is shown, there are no combinations
(for example 9999 with the sample 14 numbers).

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
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

--
Regards,
Tom Ogilvy

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
"ian123" wrote in message
...
Tom,

Thanks for your help - unfortunately its not working for me. I think
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 not
defined"

Please excuse any elementary errors on my behalf. Once again your help
is much appreciated


---
Message posted from http://www.ExcelForum.com/

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

--
Regards,
Tom Ogilvy

ian123 wrote in message
...
Tom,

Thanks for your help - unfortunately its not working for me. I think
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 not
defined"

Please excuse any elementary errors on my behalf. Once again your help
is much appreciated


---
Message posted from http://www.ExcelForum.com/

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.

--
Regards,
Tom Ogilvy

ian123 wrote in message
...
Tom,

Thanks for your help - unfortunately its not working for me. I think
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 not
defined"

Please excuse any elementary errors on my behalf. Once again your help
is much appreciated


---
Message posted from http://www.ExcelForum.com/

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.

--
Regards,
Tom Ogilvy

Doug Glancy wrote in message
...
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


"Tom Ogilvy" wrote in message
...
Put your numbers in Column B, starting in B1
Put the number to sum to in A1
Run TestBldBin

this will list all combinations in columns going to the right -
obviously
it
runs out of room at 256. If nothing is shown, there are no combinations
(for example 9999 with the sample 14 numbers).

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
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

--
Regards,
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

--
Regards,
Tom Ogilvy

Tom Ogilvy wrote in message
...
Put your numbers in Column B, starting in B1
Put the number to sum to in A1
Run TestBldBin

this will list all combinations in columns going to the right - obviously
it
runs out of room at 256. If nothing is shown, there are no combinations
(for example 9999 with the sample 14 numbers).

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
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

--
Regards,
Tom Ogilvy


Doug Glancy wrote in message
...
Greg,

I'd like to see it. One clarification, mine did combinations - I used
the
wrong phrase. Still it is slow and I was kinda waiting for the better
answers. It would be very instructive to see yours.

Doug

"Greg Wilson" wrote in message
...
I responded to your post yesterday through DevDex but it
has yet to materialize. This is at the risk of double
posting.

The trick is to first sort the values in the source range
in ascending order. Then test the combinations against
the target value using nested loops. The loops must be
designed to abort once the combination exceeds the target
value because, due to the ascending order, the
combinations can only increase. Note that this approach
is extremely fast. Also note that we are only conscerned
with combinations as apposed to permuations. For example,
12 + 44 and 44 + 12 are different permuations but are the
same combination.

I developed an extensive macro that does this a while back
which you are welcome to. It was developed for a much
more challenging situation than your example. The time
required to return the results for your example should be
essentially instantaneous.

Be advised that the number of results is extremely
sensitive to 1) the number of elements in the source list,
2) the size of the target value and 3) the maximum number
of elements allowed to sum to the target value. It is
amazingly simple to get a situation where there are many
thousands of results. I developed a filter for the macro
that lets you easily control the above parameters as well
as the maximum numbers of results returned.

Post if you're interested.

Regards,
Greg




-----Original Message-----
How can I make Excel or maybe some other program search
through 14
different numeric values say A1 thru A14 and list out the
combination
of cells that add up to exactly equal to a number that I
enter into a
particular cell?

For example if the numbers were 1-14 in the 14 cells and
I enter a 25
in a selected input cell, I want the program to list out
the cells that
add up to 25 like A1,A10,A14 or list the actual values
that equal 25
like 1,10,14 in a selected output cell.

Can this be done in Excel? If so please explain how? If
not do you know
of a program that I could purchase that will allow me do
this.

Thanks!


---
Message posted from http://www.ExcelForum.com/

.

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 )


---
Message posted from http://www.ExcelForum.com/

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.

--
Regards,
Tom Ogilvy



ian123 wrote in message
...
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 )


---
Message posted from http://www.ExcelForum.com/

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....tngp13.phx.gbl


Thanks,

Troy


---
Message posted from http://www.ExcelForum.com/

http://groups.google.com/groups?selm...gp13.phx.gb l


---
Message posted from http://www.ExcelForum.com/

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.


---
Message posted from http://www.ExcelForum.com/

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


From: twalls2
Organization: ExcelTip
Newsgroups: microsoft.public.excel.programming
Date: Thu, 18 Dec 2003 22:18:01 -0600
Subject: Can this be done in Excel?


How can I make Excel or maybe some other program search through 14
different numeric values say A1 thru A14 and list out the combination
of cells that add up to exactly equal to a number that I enter into a
particular cell?

For example if the numbers were 1-14 in the 14 cells and I enter a 25
in a selected input cell, I want the program to list out the cells that
add up to 25 like A1,A10,A14 or list the actual values that equal 25
like 1,10,14 in a selected output cell.

Can this be done in Excel? If so please explain how? If not do you know
of a program that I could purchase that will allow me do this.

Thanks!

---
Message posted from http://www.ExcelForum.com/

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

--
Message posted from http://www.ExcelForum.com