# For Fun and Learning Project

L

#### Legacy 98055

##### Guest
My son, who is in the 4th grade, was solving these puzzles. They are easy enough to do by hand, but I wanted to try an Excel and/or code approach. I know very little about what kind of algorithm one might develop to efficiently solve this and am very curious to see what a good solution would end up looking like. If anybody is really bored or considers this at all challenging, please post your solution here for the whole world to see.

BTW. You are solving for each letter. What does "A" equal, and so on..

Tj's Enrichment Packet.zip

### Excel Facts

Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

#### SydneyGeek

##### MrExcel MVP
Tom,

Here's a punt at the logic I used to get started...

1. Work out all the possible factors of 30, 40 and 48.
30 can be {1,5,6} or {2,3,5}
40 can be {1,5,8} or {2,4,5}
48 can be {1,6,8} or {2,3,8} or {2,4,6}

2. From the above, we don't need to consider 7 or 9.

3. We can also assign 2 numbers immediately: F = 0 because the only multiplication that involves it is equal to 0, and B = 5 because (i) 5 is part of the solution matrix, (ii) B is common to both calculations that have 5 as a factor, and (iii) both 30 and 40 must have a 5.

4. That leaves {1,2,3,4,6,8} to be assigned to {A,C,D,E,G,H}. We can build some restrictions for a few of the letters:
(i) C cannot be 4, because it is the junction between 30 and 48, and 4 is not a factor of 30
(ii) From the original conditions, and given that B =5, we have C + E + G =9. That leaves 8 out of this series, so either D or H must be 8.

5. Let's see how far we get with H = 8.
(i) G = 1
(ii) C + E = 8, so C can be 2 or 6. If C = 6, A must be 1 which can't happen because G = 1. So, C = 2 and A = 3.
(iii) E = 6, making D = 4.

So, solution that tries to minimise the options to test. Would that be a good starting point for a programming approach?

Denis

#### SydneyGeek

##### MrExcel MVP
Had a go with setting up a Solver solution. I was able to get a result if the values didn't have to be unique; as soon as I added that constraint, Solver spat the dummy.

5 separate runs:
Code:
``````A	1	2	2	2	2
B	5	5	5	5	5
C	6	3	3	3	3
D	4	8	4	4	8
E	2	2	4	4	2
F	0	0	0	0	0
G	1	4	2	2	4
H	8	2	4	4	2``````

It looks like the approach might still be:
1. Assign definite starting values if possible
2. Use the B+C+E+G calculation to limit the options
3. Run through all the possible starting positions of a nominated variable, rejecting any solutions that violate the "unique" condition.

Denis

#### Andrew Fergus

##### MrExcel MVP
Hi Tom and Denis

I think I have solved this one but I did make some assumptions. The biggest assumption was that there wouldn't be two products with a value of zero. I also stored a number of values within the spreadsheet to assist with the process. Using the same layout per your spreadsheet, with the values in the same cell positions, try the following code :

Code:
``````Option Explicit

'************************************************************************
'
'This code was developed by Andrew Fergus on 18 October 2006
'in response to this question on MrExcel:
'http://www.mrexcel.com/board2/viewtopic.php?t=238026
'
'************************************************************************

Public Sub SolvePuzzle()

On Error Resume Next
'Used to capture instances where the vlookup finds nothing

OuterLoop As Integer, _
TempLoop As Integer, _
Loop2 As Integer, _
Loop3 As Integer, _
LoopLimit As Integer, _
Finished(4) As Boolean, _
Values(10, 1) As Integer, _
Outcome(4) As Integer, _
TempVar1 As Integer, _
TempVar2 As Double

'Values variable:
'   holds the values 0 through 9
'   dimension 0 is used to hold the value
'   dimension 1 is used to hold the used value (where 1 = used)

'Initialise variables
Outcome(0) = Range("C3").Value
Outcome(1) = Range("C2").Value
Outcome(2) = Range("D3").Value
Outcome(3) = Range("C4").Value
Outcome(4) = Range("B3").Value
Range("G1") = "BDFH Possibles"
Range("L1") = "HAB Factors"
Range("N1") = "BCD Factors"
Range("P1") = "DEF Factors"
Range("R1") = "FGH Factors"
TempVar2 = Cells(Rows.Count, "G").End(xlUp).Row
If TempVar2 > 1 Then
Range("G2:R" & TempVar2).ClearContents
End If

'Set values to zero
For TempLoop = 0 To 10
Values(TempLoop, 0) = TempLoop
Values(TempLoop, 1) = 0
Next
For TempLoop = 0 To 8
Next
'Initialise finished variables
For TempLoop = 0 To 4
Finished(TempLoop) = False
Next

If Outcome(0) = 6 Then
'BDFH is the minima (0,1,2,3)
Range("G2") = 0
Range("H2") = 1
Range("I2") = 2
Range("J2") = 3
LoopLimit = 2
ElseIf Outcome(0) = 30 Then
'BDFH is the maxima (6,7,8,9)
Range("G2") = 6
Range("H2") = 7
Range("I2") = 8
Range("J2") = 9
LoopLimit = 2
Else
'Find the possible combinations of values for positions BDFH
GetBDFH (Outcome(0))
LoopLimit = Cells(Rows.Count, "G").End(xlUp).Row
End If

'Get the factors for the other 4 outcomes
Call GetFactors(Outcome(1), "L")
Call GetFactors(Outcome(2), "N")
Call GetFactors(Outcome(3), "P")
Call GetFactors(Outcome(4), "R")

'rowcount for debugging output
'TempVar1 = 2

For OuterLoop = 2 To LoopLimit
'Loop through all combinations of BDFH
'Get the starting values around Outcome(0)
For Loop2 = 1 To 4
'Loop through the 4 corner values (around BDFH)
If Loop2 > 1 Then
'Rotate the values around Outcome(0)
For TempLoop = 8 To 2 Step -2
Next
End If
For Loop3 = 1 To 6
If Loop3 > 1 Then
'Rotate the last 3 values around Outcome(0), but fix the lowest value
Select Case Loop2
Case 1
If Loop3 Mod 2 = 0 Then
'Mod and case used to decide which pair of digits to swap
Else
End If
Case 2
If Loop3 Mod 2 = 0 Then
Else
End If
Case 3
If Loop3 Mod 2 = 0 Then
Else
End If
Case Else
If Loop3 Mod 2 = 0 Then
Else
End If
End Select
End If

'Reset variables
'Probably not 100% necessary / efficient but effective
For TempLoop = 0 To 9
Values(TempLoop, 1) = 0
Next
For TempLoop = 1 To 4
Values(Answers(TempLoop * 2), 1) = 1
Next
For TempLoop = 1 To 4
Finished(TempLoop) = False
Next

'Set the 4 product values

'Check the first outcome
If Outcome(1) = 0 Then
TempVar2 = 0
Else
'Calculate the factor
End If
If WorksheetFunction.VLookup(TempVar2, Worksheets("Sheet1").Range("L2:L11"), 1, False) <> TempVar2 Then
'Can't find factor in the pre-set list of factors
Finished(1) = False
Else
If Values(TempVar2, 1) = 0 Then
'This value has not been used yet
Values(TempVar2, 1) = 1
Finished(1) = True
Else
'This value has already been used
Finished(1) = False
End If
End If

'Check 2nd outcome
If Outcome(2) = 0 Then
TempVar2 = 0
Else
End If
If WorksheetFunction.VLookup(TempVar2, Worksheets("Sheet1").Range("N2:N11"), 1, False) <> TempVar2 Then
Finished(2) = False
Else
If Values(TempVar2, 1) = 0 Then
Values(TempVar2, 1) = 1
Finished(2) = True
Else
Finished(2) = False
End If
End If

'Check 3rd outcome
If Outcome(3) = 0 Then
TempVar2 = 0
Else
End If
If WorksheetFunction.VLookup(TempVar2, Worksheets("Sheet1").Range("P2:P11"), 1, False) <> TempVar2 Then
Finished(3) = False
Else
If Values(TempVar2, 1) = 0 Then
Values(TempVar2, 1) = 1
Finished(3) = True
Else
Finished(3) = False
End If
End If

'Check 4th outcome
If Outcome(4) = 0 Then
TempVar2 = 0
Else
End If
If WorksheetFunction.VLookup(TempVar2, Worksheets("Sheet1").Range("R2:R11"), 1, False) <> TempVar2 Then
Finished(4) = False
Else
If Values(TempVar2, 1) = 0 Then
Values(TempVar2, 1) = 1
Finished(4) = True
Else
Finished(4) = False
End If
End If

'Used for debugging

If Finished(1) = True And Finished(2) = True And Finished(3) = True And Finished(4) = True Then
GoTo JumpOut        'Yes I know this is sloppy but hey it works!
End If
'Used for the debugging row count
'TempVar1 = TempVar1 + 1
Next
Next
Next

'If the code has ended up here it has looped through every combination
Exit Sub

JumpOut:

MsgBox "Finished"

End Sub

Private Sub GetBDFH(Outcome As Integer)

Dim RowCounter As Integer, _
Loop1 As Integer, _
Loop2 As Integer, _
Loop3 As Integer, _
Loop4 As Integer, _
MyValues(4) As Integer

RowCounter = 2

For Loop1 = 1 To 4
MyValues(Loop1) = Loop1
Next

For Loop1 = 0 To 5
For Loop2 = 1 To 6
For Loop3 = 2 To 7
For Loop4 = 3 To 9
If Loop4 < MyValues(4) Then
'Do Nothing
Else
MyValues(4) = Loop4
If MyValues(1) + MyValues(2) + MyValues(3) + MyValues(4) = Outcome Then
Range("G" & RowCounter) = MyValues(1)
Range("H" & RowCounter) = MyValues(2)
Range("I" & RowCounter) = MyValues(3)
Range("J" & RowCounter) = MyValues(4)
RowCounter = RowCounter + 1
End If
End If
Next
MyValues(3) = MyValues(3) + 1
MyValues(4) = MyValues(3) + 1
Next
MyValues(2) = MyValues(2) + 1
MyValues(3) = MyValues(2) + 1
MyValues(4) = MyValues(3) + 1
Next
MyValues(1) = MyValues(1) + 1
MyValues(2) = MyValues(1) + 1
MyValues(3) = MyValues(2) + 1
MyValues(4) = MyValues(3) + 1
Next

End Sub

Private Sub GetFactors(TestNum As Integer, ColPos As String)

Dim LoopCount As Integer, RowCounter As Integer

If TestNum = 0 Then
For LoopCount = 0 To 9
Range(ColPos & (2 + LoopCount)).Value = LoopCount
Next
Else
RowCounter = 2
For LoopCount = 1 To 9
If TestNum Mod LoopCount = 0 Then
Range(ColPos & RowCounter).Value = LoopCount
RowCounter = RowCounter + 1
End If
Next
End If

End Sub``````

The code could probably be tidied up but after a relatively quiet day, maybe I should actually do some work! (given it's almost 5pm here)

Cheers, Andrew

P.S. I also changed the A-H notation where A starts at cell C1 and then goes in clockwise direction through B at D2 and so on.

#### Andrew Fergus

##### MrExcel MVP

For such an easy puzzle, it was pretty complex to code. To clarify the approach adopted :

1) Work out the combination of values that add to the central number.

In this example there were only 5 possible combinations that could give the number 14. These combinations are stored within the spreadsheet for ease of access later on. Major assumption : a zero is not in one of these four positions (this could be factored into the code but I opted to leave it out at the moment).

2) Work out all of the possible factors for the 4 product values.

These will be used later as part of lookup routine so they are stored within the spreadsheet. The maximum number of factors for any one product is 10 (ie where the product = 0).

3) Using shuffling techniques (that I just made that up) hold one of the 4 middle values stationery and swap all of the others around. Repeat for the held number in all 4 possible positions. Test each permutation per step 4 below.

This puts all possible combinations of 14 into the 4 different positions (mine was BDFH, the original example was BCEG). In this case there were 5 combinations * 4 positions * 6 permutations = 120 permutations to test. For a median value like 18, there are 11 possible combinations and 11 * 4 * 6 = 264 possible solutions to test. Not bad considering Fact(9) = 362k if you tried a pure brute force method.

4) Test each permutation / possible solution as follows : given we have two of the three values required for the product, calculate the third value to see what the missing factor is. If this factor is in the list of possible factors, then that is good and we need to test the other 3 missing numbers. If not then this 'solution' is discarded and we try another.

The code runs pretty quickly (my tests are about 3 seconds on solutions designed to push my algorithms to their end values) but it could be faster.

Andrew

#### Andrew Fergus

##### MrExcel MVP
This version runs a little quicker (sub 2 seconds) given the introduction of a couple of goto statements (yes I know...) and I've tweaked a couple of the loops.

If I copy this code into your spreadsheet Tom it doesn't find the answer, but if I type the values into my own spreadsheet it does!?!

Code:
``````Option Explicit

'************************************************************************
'
'This code was developed by Andrew Fergus on 18 October 2006
'in response to this question on MrExcel:
'http://www.mrexcel.com/board2/viewtopic.php?t=238026
'
'************************************************************************

Public Sub SolvePuzzle()

On Error Resume Next
'Used to capture instances where the vlookup finds nothing

OuterLoop As Integer, _
TempLoop As Integer, _
Loop2 As Integer, _
Loop3 As Integer, _
LoopLimit As Integer, _
Finished(4) As Boolean, _
Values(10, 1) As Integer, _
Outcome(4) As Integer, _
TempVar1 As Integer, _
TempVar2 As Double

'Values variable:
'   holds the values 0 through 9
'   dimension 0 is used to hold the value
'   dimension 1 is used to hold the used value (where 1 = used)

'Initialise variables
Outcome(0) = Range("C3").Value
Outcome(1) = Range("C2").Value
Outcome(2) = Range("D3").Value
Outcome(3) = Range("C4").Value
Outcome(4) = Range("B3").Value
Range("G1") = "BDFH Possibles"
Range("L1") = "HAB Factors"
Range("N1") = "BCD Factors"
Range("P1") = "DEF Factors"
Range("R1") = "FGH Factors"
TempVar2 = Cells(Rows.Count, "G").End(xlUp).Row
If TempVar2 > 1 Then
Range("G2:R" & TempVar2).ClearContents
End If

'Set the values
For TempLoop = 0 To 10
Values(TempLoop, 0) = TempLoop
Values(TempLoop, 1) = 0
Next
For TempLoop = 0 To 8
Next

If Outcome(0) = 6 Then
'BDFH is the minima (0,1,2,3)
Range("G2") = 0
Range("H2") = 1
Range("I2") = 2
Range("J2") = 3
LoopLimit = 2
ElseIf Outcome(0) = 30 Then
'BDFH is the maxima (6,7,8,9)
Range("G2") = 6
Range("H2") = 7
Range("I2") = 8
Range("J2") = 9
LoopLimit = 2
Else
'Find the possible combinations of values for positions BDFH
GetBDFH (Outcome(0))
LoopLimit = Cells(Rows.Count, "G").End(xlUp).Row
End If

'Get the factors for the other 4 outcomes
Call GetFactors(Outcome(1), "L")
Call GetFactors(Outcome(2), "N")
Call GetFactors(Outcome(3), "P")
Call GetFactors(Outcome(4), "R")

'rowcount for debugging output
'TempVar1 = 2

For OuterLoop = 2 To LoopLimit
'Loop through all combinations of BDFH
'Get the starting values around Outcome(0)
For Loop2 = 1 To 4
'Loop through the 4 corner values (around BDFH)
If Loop2 > 1 Then
'Rotate the values around Outcome(0)
For TempLoop = 8 To 2 Step -2
Next
End If
For Loop3 = 1 To 6
If Loop3 > 1 Then
'Rotate the last 3 values around Outcome(0), but fix the lowest value
Select Case Loop2
Case 1
If Loop3 Mod 2 = 0 Then
'Mod and case used to decide which pair of digits to swap
Else
End If
Case 2
If Loop3 Mod 2 = 0 Then
Else
End If
Case 3
If Loop3 Mod 2 = 0 Then
Else
End If
Case Else
If Loop3 Mod 2 = 0 Then
Else
End If
End Select
End If

'Reset variables
For TempLoop = 0 To 9
Values(TempLoop, 1) = 0
Next
For TempLoop = 1 To 4
Values(Answers(TempLoop * 2), 1) = 1
Next
For TempLoop = 1 To 4
Finished(TempLoop) = False
Next

'Set the 4 product values

'Check the first outcome
If Outcome(1) = 0 Then
TempVar2 = 0
Else
'Calculate the factor
End If
If WorksheetFunction.VLookup(TempVar2, Worksheets("Sheet1").Range("L2:L11"), 1, False) <> TempVar2 Then
'Can't find factor in the pre-set list of factors
Finished(1) = False
'No point testing the other 3 products
GoTo Skip_To_Here
Else
If Values(TempVar2, 1) = 0 Then
'This value has not been used yet
Values(TempVar2, 1) = 1
Finished(1) = True
Else
'This value has already been used
Finished(1) = False
GoTo Skip_To_Here
End If
End If

'Check 2nd outcome
If Outcome(2) = 0 Then
TempVar2 = 0
Else
End If
If WorksheetFunction.VLookup(TempVar2, Worksheets("Sheet1").Range("N2:N11"), 1, False) <> TempVar2 Then
Finished(2) = False
GoTo Skip_To_Here
Else
If Values(TempVar2, 1) = 0 Then
Values(TempVar2, 1) = 1
Finished(2) = True
Else
Finished(2) = False
GoTo Skip_To_Here
End If
End If

'Check 3rd outcome
If Outcome(3) = 0 Then
TempVar2 = 0
Else
End If
If WorksheetFunction.VLookup(TempVar2, Worksheets("Sheet1").Range("P2:P11"), 1, False) <> TempVar2 Then
Finished(3) = False
GoTo Skip_To_Here
Else
If Values(TempVar2, 1) = 0 Then
Values(TempVar2, 1) = 1
Finished(3) = True
Else
Finished(3) = False
GoTo Skip_To_Here
End If
End If

'Check 4th outcome
If Outcome(4) = 0 Then
TempVar2 = 0
Else
End If
If WorksheetFunction.VLookup(TempVar2, Worksheets("Sheet1").Range("R2:R11"), 1, False) <> TempVar2 Then
Finished(4) = False
Else
If Values(TempVar2, 1) = 0 Then
Values(TempVar2, 1) = 1
Finished(4) = True
Else
Finished(4) = False
End If
End If

Skip_To_Here:

'Used for debugging

If Finished(1) = True And Finished(2) = True And Finished(3) = True And Finished(4) = True Then
GoTo JumpOut        'Yes I know this is sloppy but hey it works!
End If
'Used for the debugging row count
'TempVar1 = TempVar1 + 1
Next
Next
Next

'If the code has ended up here it has looped through every combination
Range("C1").Value = "?"
Range("D2").Value = "?"
Range("E3").Value = "?"
Range("D4").Value = "?"
Range("C5").Value = "?"
Range("B4").Value = "?"
Range("A3").Value = "?"
Range("B2").Value = "?"
Exit Sub

'If a combination is found then the loop jumps out to here
JumpOut:

MsgBox "Finished"

End Sub

Private Sub GetBDFH(Outcome As Integer)

Dim RowCounter As Integer, _
GLoop1 As Integer, _
GLoop2 As Integer, _
GLoop3 As Integer, _
GLoop4 As Integer

RowCounter = 2

For GLoop1 = 1 To 5
For GLoop2 = (GLoop1 + 1) To 6
For GLoop3 = (GLoop2 + 1) To 7
For GLoop4 = (GLoop3 + 1) To 9
If GLoop1 + GLoop2 + GLoop3 + GLoop4 = Outcome Then
Range("G" & RowCounter) = GLoop1
Range("H" & RowCounter) = GLoop2
Range("I" & RowCounter) = GLoop3
Range("J" & RowCounter) = GLoop4
RowCounter = RowCounter + 1
End If
Next
Next
Next
Next

End Sub

Private Sub GetFactors(TestNum As Integer, ColPos As String)

Dim LoopCount As Integer, RowCounter As Integer

If TestNum = 0 Then
For LoopCount = 0 To 9
Range(ColPos & (2 + LoopCount)).Value = LoopCount
Next
Else
RowCounter = 2
For LoopCount = 1 To 9
If TestNum Mod LoopCount = 0 Then
Range(ColPos & RowCounter).Value = LoopCount
RowCounter = RowCounter + 1
End If
Next
End If

End Sub``````
A

L

#### Legacy 98055

##### Guest

Thanks Andrew and Denis. Andrew, your solution worked very fast for me on a somewhat older computer and solved the problem pretty much instantaneously. Because your code is complicated (too me anyway), I appreciate the explanation. I tried your code on another puzzle that I made up in random. It worked sometimes and did not at others. I looked for module level variables or some other cause for this. When you have time, please comment on the attached...

Denis. Thanks for your good comments as well. The reason why this little problem aroused my curiosty is because I want to gain some more problem solving skills. Will be starting college in a few weeks and am gung ho for learning AMAP. Thanks for the input...

Tj's Enrichment Packet - Andrew.zip

#### Andrew Fergus

##### MrExcel MVP
Hi Tom

When I run the code in your spreadsheets the vlookup line fails and it can't find the factor and accordingly can't find the solution (even if it is trying to look up a value that is in the list!). However, when I run this over my own spreadsheets, it works. Is this a floating point error? The vlookup part of the code did cause a number of problems and I'm wondering if there is a better way of coding that - maybe working out the missing factor and then seeing if that is a geniune factor via another subroutine - it will slow the code but will prevent these errors. Hmmm - I might have to give that a go.

Cheers, Andrew

#### SydneyGeek

##### MrExcel MVP
Hi Andrew,
I think I have solved this one but I did make some assumptions. The biggest assumption was that there wouldn't be two products with a value of zero.
That's a fair enough assumption. If there's a double 0, that means you have a 0 at one of the vertices of {B,D,F,H} (your layout) and 2 unknowns with 4 possible numbers. That gives 12 possible solutions.

A suggestion for reducing the #of possible starting positions: as you said, 18 can be the sum of 11 combinations of 4 numbers. Some of those will contain numbers that are NOT factors of the 3-way multiples, so they can be removed before you start looping.

Food for thought...

Denis

#### SydneyGeek

##### MrExcel MVP
Andrew, I did some playing with your solution. I reckon there's a couple of simple refinements that you can make.

1. If one of the outcomes is 0, don't factor it.
2. In columns T and U, build values 0 to 9 (T2:T11) and a count of all factors found (U2:U11)
3. Then use this list to remove any BDFH Possibles containing a value that is not a factor.

The following code does items 2 and 3:
Code:
``````Sub TrimOptions()
Dim vOut() As Variant
Dim c As Range

vOut = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)

Range("T2:T11") = WorksheetFunction.Transpose(vOut)
Range("U2:U11").FormulaR1C1 = "=COUNTIF(R2C12:R11C18,RC[-1])"

For Each c In Range("G2:J" & Range("J65536").End(xlUp).Row)
If Not IsEmpty(c) Then
If WorksheetFunction.VLookup(c.Value, Range("T2:U11"), 2, False) = 0 Then
Cells(c.Row, 7).Resize(1, 4).Delete Shift:=xlShiftUp
End If
End If
Next c
End Sub``````
You would call it once the items are factored and the possibles list is built, but before running the outer loops. This may eliminate the crash that Tom found, without you needing to check the VLOOKUP output all the time.

Denis

1,141,920
Messages
5,709,349
Members
421,631
Latest member
JDamery

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back