Can this be done in Excel?

[twalls2]

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/

[Ben.c]

Hi,
I suppose that your data are in column A and the particular cell is C1
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 Range

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

if rangecell is not nothing then
MsgBox ("The cell wicht have the same number than the particular one are:" & rangecell.Address)
end if
End Sub

[twalls2]

Thanks for the response but unfortunately it didn't work.

If anybody knows how to accomplish this I would greatly appreciate any
help I can get.

Thanks a Bunch!

[Doug Glancy]

I've been looking at this for a while now. I think the short answer is that
it's impracticable because of the number of permutations. The way I figure
it (not a mathematician) the number of permutations is the 2 to the power of
the high number, e.g., 14 in your request is 16,384 combinations of possible
number to look at.

Anyways, I went ahead and wrote something that prints the combos to the
second spreadsheet in the workbook. It asks you for the high number, e.g.,
14 and the number you are looking for. If you enter a high number more than
16, it won't print the sheet because 2 to the power of 16 is 65,536, the
number of rows in a sheet. I entered 16 and got tired of waiting for it to
calculate. So my advice is start with small numbers and work your way up
and save your work before hand.

Anyways, it show all the possible combinations and highlights the ones
you're looking for on the spreadsheet.

The other part of the macro is that it writes the combos that add up to your
target number to the immediate window.

Let me know what you think:

Sub combo_nums()

Dim high_num, find_num, combo_num, combos(), i, j, k, _
group_start, group_end, increment, result As Double

Worksheets(1).Cells.Clear
Application.ScreenUpdating = False

high_num = CDbl(InputBox("Highest Number"))
find_num = CDbl(InputBox("Number to Find"))

combo_num = (2 ^ high_num) - 1
ReDim combos(1 To high_num, 1 To combo_num)

For i = 1 To high_num
increment = (combo_num + 1) / (2 ^ i)
For j = 1 To 2 ^ (i - 1)
group_start = 1 + (increment * 2) * (j - 1)
group_end = group_start + increment - 1
For k = group_start To group_end
combos(i, k) = i
Next k
Next j
Next i

If high_num <= 16 Then
For i = 1 To high_num
For j = 1 To combo_num
Worksheets(1).Cells(j, i) = combos(i, j)
Next j
Next i
Worksheets(1).Range(Worksheets(1).Cells(1, high_num + 2), _
Worksheets(1).Cells(combo_num, high_num + 2)) _
.FormulaR1C1 = "=SUM(RC[-" & high_num + 1 & "]:RC[-2])"
For i = combo_num To 1 Step -1
If Worksheets(1).Cells(i, high_num + 2).Value = find_num Then
Worksheets(1).Rows(i).EntireRow.Font.Bold = True
End If
Next i
Worksheets(1).UsedRange.Columns.AutoFit
Else
MsgBox "Not enough rows in spreadsheet" & vbCrLf & " to list all the
permutations"
End If

Application.ScreenUpdating = True

For j = 1 To combo_num
result = 0
For i = 1 To high_num
result = result + combos(i, j)
Next i
If result = find_num Then
For k = 1 To high_num
Debug.Print combos(k, j);
Next k
Debug.Print vbCrLf
End If
Next j

End Sub

"twalls2" <twalls...@excelforum-nospam.com> wrote in message
news:twalls...@excelforum-nospam.com...

[twalls2]

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!

[twalls2]

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.

[Doug Glancy]

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

Doug

"twalls2" <twalls...@excelforum-nospam.com> wrote in message
news:twalls...@excelforum-nospam.com...

[twalls2]

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

Thanks again for all your help!

Troy

[Tom Ogilvy]

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?threadm=e3iWLUiYDHA.2960%40tk2msftngp13.phx.
gbl

--
Regards,
Tom Ogilvy

twalls2 <twalls...@excelforum-nospam.com> wrote in message
news:twalls...@excelforum-nospam.com...

[Greg Wilson]

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

>.
>

[Doug Glancy]

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" <anon...@discussions.microsoft.com> wrote in message
news:02e101c3c735$7cc27a20$a101...@phx.gbl...

[Doug Glancy]

Troy,

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

Doug

"twalls2" <twalls...@excelforum-nospam.com> wrote in message
news:twalls...@excelforum-nospam.com...

[Greg Wilson]

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

>.
>

[Doug Glancy]

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

Doug

"Tom Ogilvy" <twog...@msn.com> wrote in message
news:vu99jb2...@news.supernews.com...

[Tom Ogilvy]

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 <d...@deegee.com> wrote in message
news:O$K5kA0xD...@TK2MSFTNGP09.phx.gbl...

[Doug Glancy]

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" <anon...@discussions.microsoft.com> wrote in message

news:00de01c3c749$2c9750c0$a501...@phx.gbl...

[ian123]

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.

[Tom Ogilvy]

My code solved all your test values.

--
Regards,
Tom Ogilvy

ian123 <ian123...@excelforum-nospam.com> wrote in message
news:ian123...@excelforum-nospam.com...

[Greg Wilson]

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

[Doug Glancy]

Thanks Greg.

I'll reconstitute and try it.

Doug

"Greg Wilson" <anon...@discussions.microsoft.com> wrote in message

news:012b01c3c752$44e61180$a601...@phx.gbl...
Doug,

Hope it goes well.

Regards,
Greg

End If

EndMsg:

RefCell.EntireColumn.AutoFit

End Sub

.Caption = "Tolerance (ą) Pct"

[ian123]

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

[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

"Tom Ogilvy" <twog...@msn.com> wrote in message

news:vu9kdv7...@news.supernews.com...

[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

"ian123" <ian123...@excelforum-nospam.com> wrote in message
news:ian123...@excelforum-nospam.com...

[Tom Ogilvy]

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

--
Regards,
Tom Ogilvy

ian123 <ian123...@excelforum-nospam.com> wrote in message
news:ian123...@excelforum-nospam.com...

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

--
Regards,
Tom Ogilvy

ian123 <ian123...@excelforum-nospam.com> wrote in message
news:ian123...@excelforum-nospam.com...

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

--
Regards,
Tom Ogilvy

Doug Glancy <d...@deegee.com> wrote in message

news:er7xIz1x...@TK2MSFTNGP11.phx.gbl...

[Tom Ogilvy]

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

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 <twog...@msn.com> wrote in message
news:vu9kdv7...@news.supernews.com...

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

--
Regards,
Tom Ogilvy

ian123 <ian123...@excelforum-nospam.com> wrote in message
news:ian123...@excelforum-nospam.com...

[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/groups?selm=e3iWLUiYDHA.2960%40tk2msftngp13.phx.gbl

[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

From: twalls2 <twalls...@excelforum-nospam.com>
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!