Number Problem

Sean Stevens · Nov 12, 2004

Has anyone come across a solution to this problem.

I have 6 numbers ranging from 1 to 100 in cells A1:A6.

I have a target number in cell C1. Using any combination of the 6 numbers and any combination of the arithemtic signs +,-,* or /, can you reach the target number??

I have been able to do this with just using the + sign, but it gets difficult after that...

Any ideas??? Thanks, Sean.

PA HS Teacher · Nov 15, 2004

Pretty Slick!
I especially like the part where you check to make sure you're not using one of the 6 digits more than once by stringing 1's -6's in your p loop. I played around with your code a little bit and I too got it to where it seems to solve all problems in under 3 minutes.

To speed things up I:
- Turned off the screen updating
- Wrote all results to the same cell
- exited the looping when the magic number was reached

Many solutions seem to take a couple of seconds. Even if the entire sequence were completed it would take my computer just over 2 minutes to finish. Each cycle of the i loop takes my computer about 21 seconds.

I'm still relatively new at this game, but I was wondering. Any time VB writes to a sheet or requires a spreadsheet function, the code runs relatively slow, especially with many loops. (at least that has been my limited experience) Two things come to mind:

1) Is there a way to perform the function of your p loop without calling a
worksheet function. (in this case substitute)

2) Is there a way to calculate the resulting number for a given
combination of the 6 numbers and 4 operators without writing to the
spreadsheet at all. (and without requiring the spreadsheet to
calculate at all.) A way to do it using strictly VB ?

PaddyD · Nov 15, 2004

"...If interested, let me know via PM."

Hi yee388,

It detracts from the very purpose of the board to only disclose solutions to problems in private!

yee388 · Nov 15, 2004

That was my question too. I have no idea how to code the operations without hard-coding all 1,024 possibilities...

i.e. if Operator1 = "+", how do you code: 1 Operator1 2 = 3?

I noticed that the screen updating cut the time by 1/5, and I did throw a test in to exit once a goal is reached.

I looked up the rules to the gameshow (since I've never seen it), and there is a pretty significant change to the code. The rules of the game allow for 6 numbers from two sets: {1:10} and {25,50,75, or 100}

Numbers in the small set are allowed twice, while there can only be one of the big numbers. So, I had to do away with the String method of testing repeats, and had to settle for writing each value to a cell and using COUNTIF. Still looking for a better solution to that.

I also have 4 loops now, one that tests for a possible 3,4,5, or 6 value statement, since in the show you don't HAVE to use all the values...

Very interesting project, though.

yee388 · Nov 15, 2004

This is my code ver.II:

Assumptions:
A2:A7 contain 6 values that conform to the CountDown rules
B2: =COUNTIF($A$2:$A$7,A2) and fill through B7
O5 holds a non-zero target number

The macro writes the rest of what you will see.

Yes, I know the placement is strange... I did this in a hurry.

Sub CountDown()

Dim ValueArray(8)
Dim OperatorArray(3)
Dim r, c As Long

Range("C9:M9", "O9").ClearContents

Application.ScreenUpdating = False

'Get Values from A2:A7
For a = 0 To 5
 ValueArray(a) = Range("A" & a + 2)
Next a

'Initialize operators
OperatorArray(0) = "+"
OperatorArray(1) = "-"
OperatorArray(2) = "/"
OperatorArray(3) = "*"

'Initialize row and column values
r = 1
c = 3

StartTime = Timer

Do

'Run possibilities for 3 value strings

For i = 0 To 5
For j = 0 To 5
For k = 0 To 5

 For v = 0 To 3
 For w = 0 To 3

 'Paste Values
 Cells(9, 3) = ValueArray(i)
 Cells(9, 5) = ValueArray(j)
 Cells(9, 7) = ValueArray(k)
 Cells(9, 4) = OperatorArray(v)
 Cells(9, 6) = OperatorArray(w)

 'Make sure all values are unique
 For b = 3 To 7 Step 2
 NumUses = WorksheetFunction.CountIf(Range("C9:M9"), Cells(9, b))
 MaxUses = WorksheetFunction.Index(Range("A2:B7"), WorksheetFunction.Match(Cells(9, b), Range("A2:A7"), 0), 2)
 If NumUses > MaxUses Then GoTo SkipValue3
 Next b

 'Paste formula
 Cells(9, 15) = "=" & ValueArray(i) & OperatorArray(v) & ValueArray(j) & OperatorArray(w) & ValueArray(k)

 'Test for goal
 If Range("O9").Value = Range("O5").Value Then GoTo ByeBye

 Next w
 Next v

SkipValue3:

Next k
Next j
Next i

'Run possibilities for 4 value strings

For i = 0 To 5
For j = 0 To 5
For k = 0 To 5
For l = 0 To 5

 For v = 0 To 3
 For w = 0 To 3
 For x = 0 To 3

 'Paste Values
 'This is probably pretty expensive, but Countif is the only way I can
 'think of to make sure values aren't overused...
 Cells(9, 3) = ValueArray(i)
 Cells(9, 5) = ValueArray(j)
 Cells(9, 7) = ValueArray(k)
 Cells(9, 9) = ValueArray(l)
 Cells(9, 4) = OperatorArray(v)
 Cells(9, 6) = OperatorArray(w)
 Cells(9, 8) = OperatorArray(x)

 'Make sure all values are unique
 For b = 3 To 7 Step 2
 NumUses = WorksheetFunction.CountIf(Range("C9:M9"), Cells(9, b))
 MaxUses = WorksheetFunction.Index(Range("A2:B7"), WorksheetFunction.Match(Cells(9, b), Range("A2:A7"), 0), 2)
 If NumUses > MaxUses Then GoTo SkipValue4
 Next b

 'Paste formula
 Cells(9, 15) = "=" & ValueArray(i) & OperatorArray(v) & ValueArray(j) & OperatorArray(w) & ValueArray(k) & OperatorArray(x) & ValueArray(l)

 'Test for goal
 If Range("O9").Value = Range("O5").Value Then GoTo ByeBye

 Next x
 Next w
 Next v

SkipValue4:

Next l
Next k
Next j
Next i

'Run possibilities for 5 value strings

For i = 0 To 5
For j = 0 To 5
For k = 0 To 5
For l = 0 To 5
For m = 0 To 5

 For v = 0 To 3
 For w = 0 To 3
 For x = 0 To 3
 For y = 0 To 3

 'Paste Values
 Cells(9, 3) = ValueArray(i)
 Cells(9, 5) = ValueArray(j)
 Cells(9, 7) = ValueArray(k)
 Cells(9, 9) = ValueArray(l)
 Cells(9, 11) = ValueArray(m)
 Cells(9, 4) = OperatorArray(v)
 Cells(9, 6) = OperatorArray(w)
 Cells(9, 8) = OperatorArray(x)
 Cells(9, 10) = OperatorArray

'Make sure all values are unique
 For b = 3 To 11 Step 2
 NumUses = WorksheetFunction.CountIf(Range("C9:M9"), Cells(9, b))
 MaxUses = WorksheetFunction.Index(Range("A2:B7"), WorksheetFunction.Match(Cells(9, b), Range("A2:A7"), 0), 2)
 If NumUses > MaxUses Then GoTo SkipValue5
 Next b

 'Paste formula
 Cells(9, 15) = "=" & ValueArray(i) & OperatorArray(v) & ValueArray(j) & OperatorArray(w) & ValueArray(k) _
 & OperatorArray(x) & ValueArray(l) & OperatorArray

& ValueArray(m)

 'Test for goal
 If Range("O9").Value = Range("O5").Value Then GoTo ByeBye

 Next y
 Next x
 Next w
 Next v

SkipValue5:

Next m
Next l
Next k
Next j
Next i

'Run possibilities for 6 value strings
For i = 0 To 5
For j = 0 To 5
For k = 0 To 5
For l = 0 To 5
For m = 0 To 5
For n = 0 To 5

 For v = 0 To 3
 For w = 0 To 3
 For x = 0 To 3
 For y = 0 To 3
 For z = 0 To 3

 'Paste Values
 Cells(9, 3) = ValueArray(i)
 Cells(9, 5) = ValueArray(j)
 Cells(9, 7) = ValueArray(k)
 Cells(9, 9) = ValueArray(l)
 Cells(9, 11) = ValueArray(m)
 Cells(9, 13) = ValueArray

        Cells(9, 4) = OperatorArray(v)
        Cells(9, 6) = OperatorArray(w)
        Cells(9, 8) = OperatorArray(x)
        Cells(9, 10) = OperatorArray

Cells(9, 12) = OperatorArray(z)

 'Make sure all values are unique
 For b = 3 To 13 Step 2
 NumUses = WorksheetFunction.CountIf(Range("C9:M9"), Cells(9, b))
 MaxUses = WorksheetFunction.Index(Range("A2:B7"), WorksheetFunction.Match(Cells(9, b), Range("A2:A7"), 0), 2)
 If NumUses > MaxUses Then GoTo SkipValue6
 Next b

 'Paste formula
 Cells(9, 15) = "=" & ValueArray(i) & OperatorArray(v) & ValueArray(j) & OperatorArray(w) & ValueArray(k) _
 & OperatorArray(x) & ValueArray(l) & OperatorArray

& ValueArray(m) & OperatorArray(z) & ValueArray

'Test for goal
 If Range("O9").Value = Range("O5").Value Then GoTo ByeBye

 Next z
 Next y
 Next x
 Next w
 Next v

SkipValue6:

Next n
Next m
Next l
Next k
Next j
Next i

Loop

MsgBox "Sorry, that goal is not possible."

ByeBye:

EndTime = Timer

Application.ScreenUpdating = True

MsgBox "Process took " & EndTime - StartTime & " seconds"

End Sub

PA HS Teacher · Nov 15, 2004

If one were to view this like a lottery, where you pick 6 possibilities. Let's think about how many possibilities there would be to select from...

1,2,3,4,5,6,7,8,9,10 ...but really twice that...
1,2,3,4,5,6,7,8,9,10
and
25,50,75,100 [so far 24 possibilities]

Each of which will have one of the four operators in front of it.
(I guess technically the first number chosen will always have the + operator)

As I see it, loosely speaking, that's 4 * 24 or 96 possibilities. (more than in a typical state lottery)

I am ashamed to say that I do not remember the rules for calculating the probability of picking 6 (non replaced) numbers from a pool of n numbers. I think it would be something like n factorial/(n-r) factorial, but its been awhile and I don't remember. Does someone remember the rules for this type of probability?

In any case, it looks like odds of cracking one of these problems in under 3 minutes is pretty slim. A solution to this problem may require less brute force and more creative coding. At least for this evening, I will have to drop back and punt.

yee388 · Nov 16, 2004

Well, you actually don't have to pick from all 24 possibilities. In the show you say, "I want 4 small numbers and 2 large." (Someone who has seen the show, please correct me if I'm wrong...)

So they give you (at random), 4 numbers from the small set (it would be possible to draw something like {2,2,3,3}, and then 2 numbers from the large set {75, 100}.

So your pool is always 6 values, not 24.

Sean Stevens · Nov 16, 2004

yee388 - Excellent work..The only improvement I can think of is to keep track of the closest number to the target, in case it is not possible to find a combination.

So instead of saying "Sorry, that goal is not possible.", but the closest possible number to the target is....this might be quite difficult though

yee388 · Nov 16, 2004

I wasn't aware that "close" counted as anything... I'll give it a try. I don't think it'll be too big of a problem.

mdusoe · Nov 16, 2004

You asked about calculating a value without using a cell...

Why not use Evaluate? I know that Evaluate("5+3*2") returns 11, so I would think that you could utilize that.

yee388 · Nov 16, 2004

That works wonderfully. Between ScreenUpdating = False and Evaluate(), this thing is really flying now. I'm getting most solutions in under 10 seconds now.

Sean, still working on that "closest" bit.

Number Problem

Sean Stevens

Board Regular

PA HS Teacher

Well-known Member

Excel Facts

PaddyD

MrExcel MVP

yee388

Well-known Member

yee388

Well-known Member

PA HS Teacher

Well-known Member

yee388

Well-known Member

Sean Stevens

Board Regular

yee388

Well-known Member

mdusoe

Active Member

yee388

Well-known Member

Similar threads

Forum statistics

Share this page

Number Problem

Board Regular

Well-known Member

Excel Facts

MrExcel MVP

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Board Regular

Well-known Member

Active Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock