For Fun and Learning Project

Legacy 98055 · Oct 15, 2006

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

SydneyGeek · Oct 17, 2006

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 · Oct 17, 2006

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 · Oct 17, 2006

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

Dim Answers(8) As Integer, _
    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
'Set answers to zero
For TempLoop = 0 To 8
    Answers(TempLoop) = 0
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)
    Answers(2) = Range("G" & OuterLoop).Value
    Answers(4) = Range("H" & OuterLoop).Value
    Answers(6) = Range("I" & OuterLoop).Value
    Answers(8) = Range("J" & OuterLoop).Value
    For Loop2 = 1 To 4
    'Loop through the 4 corner values (around BDFH)
        If Loop2 > 1 Then
        'Rotate the values around Outcome(0)
            Answers(0) = Answers(8)
            For TempLoop = 8 To 2 Step -2
                Answers(TempLoop) = Answers(TempLoop - 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
                            Answers(0) = Answers(8)
                            Answers(8) = Answers(6)
                            Answers(6) = Answers(0)
                        Else
                            Answers(0) = Answers(6)
                            Answers(6) = Answers(4)
                            Answers(4) = Answers(0)
                        End If
                    Case 2
                        If Loop3 Mod 2 = 0 Then
                            Answers(0) = Answers(8)
                            Answers(8) = Answers(6)
                            Answers(6) = Answers(0)
                        Else
                            Answers(0) = Answers(6)
                            Answers(6) = Answers(2)
                            Answers(2) = Answers(0)
                        End If
                    Case 3
                        If Loop3 Mod 2 = 0 Then
                            Answers(0) = Answers(8)
                            Answers(8) = Answers(4)
                            Answers(4) = Answers(0)
                        Else
                            Answers(0) = Answers(4)
                            Answers(4) = Answers(2)
                            Answers(2) = Answers(0)
                        End If
                    Case Else
                        If Loop3 Mod 2 = 0 Then
                            Answers(0) = Answers(6)
                            Answers(6) = Answers(4)
                            Answers(4) = Answers(0)
                        Else
                            Answers(0) = Answers(4)
                            Answers(4) = Answers(2)
                            Answers(2) = Answers(0)
                        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
            Answers(1) = 0
            Answers(3) = 0
            Answers(5) = 0
            Answers(7) = 0
            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
                TempVar2 = Outcome(1) / (Answers(2) * Answers(8))
            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
                    Answers(1) = TempVar2
                    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
                TempVar2 = Outcome(2) / (Answers(2) * Answers(4))
            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
                    Answers(3) = TempVar2
                    Finished(2) = True
                Else
                    Finished(2) = False
                End If
            End If
            
            'Check 3rd outcome
            If Outcome(3) = 0 Then
                TempVar2 = 0
            Else
                TempVar2 = Outcome(3) / (Answers(4) * Answers(6))
            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
                    Answers(5) = TempVar2
                    Finished(3) = True
                Else
                    Finished(3) = False
                End If
            End If
            
            'Check 4th outcome
            If Outcome(4) = 0 Then
                TempVar2 = 0
            Else
                TempVar2 = Outcome(4) / (Answers(6) * Answers(8))
            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
                    Answers(7) = TempVar2
                    Finished(4) = True
                Else
                    Finished(4) = False
                End If
            End If
            
            'Used for debugging
            'Range("AA" & TempVar1).Value = Answers(1)
            'Range("AB" & TempVar1).Value = Answers(2)
            'Range("AC" & TempVar1).Value = Answers(3)
            'Range("AD" & TempVar1).Value = Answers(4)
            'Range("AE" & TempVar1).Value = Answers(5)
            'Range("AF" & TempVar1).Value = Answers(6)
            'Range("AG" & TempVar1).Value = Answers(7)
            'Range("AH" & TempVar1).Value = Answers(8)
            
            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
MsgBox "Answer not found"
Exit Sub

JumpOut:

'Display the answers
Range("C1").Value = Answers(1)
Range("D2").Value = Answers(2)
Range("E3").Value = Answers(3)
Range("D4").Value = Answers(4)
Range("C5").Value = Answers(5)
Range("B4").Value = Answers(6)
Range("A3").Value = Answers(7)
Range("B2").Value = Answers(8)

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 · Oct 18, 2006

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 · Oct 18, 2006

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

Dim Answers(8) As Integer, _
    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
'Set initial answers to zero
For TempLoop = 0 To 8
    Answers(TempLoop) = 0
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)
    Answers(2) = Range("G" & OuterLoop).Value
    Answers(4) = Range("H" & OuterLoop).Value
    Answers(6) = Range("I" & OuterLoop).Value
    Answers(8) = Range("J" & OuterLoop).Value
    For Loop2 = 1 To 4
    'Loop through the 4 corner values (around BDFH)
        If Loop2 > 1 Then
        'Rotate the values around Outcome(0)
            Answers(0) = Answers(8)
            For TempLoop = 8 To 2 Step -2
                Answers(TempLoop) = Answers(TempLoop - 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
                            Answers(0) = Answers(8)
                            Answers(8) = Answers(6)
                            Answers(6) = Answers(0)
                        Else
                            Answers(0) = Answers(6)
                            Answers(6) = Answers(4)
                            Answers(4) = Answers(0)
                        End If
                    Case 2
                        If Loop3 Mod 2 = 0 Then
                            Answers(0) = Answers(8)
                            Answers(8) = Answers(6)
                            Answers(6) = Answers(0)
                        Else
                            Answers(0) = Answers(6)
                            Answers(6) = Answers(2)
                            Answers(2) = Answers(0)
                        End If
                    Case 3
                        If Loop3 Mod 2 = 0 Then
                            Answers(0) = Answers(8)
                            Answers(8) = Answers(4)
                            Answers(4) = Answers(0)
                        Else
                            Answers(0) = Answers(4)
                            Answers(4) = Answers(2)
                            Answers(2) = Answers(0)
                        End If
                    Case Else
                        If Loop3 Mod 2 = 0 Then
                            Answers(0) = Answers(6)
                            Answers(6) = Answers(4)
                            Answers(4) = Answers(0)
                        Else
                            Answers(0) = Answers(4)
                            Answers(4) = Answers(2)
                            Answers(2) = Answers(0)
                        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
            Answers(1) = 0
            Answers(3) = 0
            Answers(5) = 0
            Answers(7) = 0
            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
                TempVar2 = Outcome(1) / (Answers(2) * Answers(8))
            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
                    Answers(1) = TempVar2
                    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
                TempVar2 = Outcome(2) / (Answers(2) * Answers(4))
            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
                    Answers(3) = TempVar2
                    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
                TempVar2 = Outcome(3) / (Answers(4) * Answers(6))
            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
                    Answers(5) = TempVar2
                    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
                TempVar2 = Outcome(4) / (Answers(6) * Answers(8))
            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
                    Answers(7) = TempVar2
                    Finished(4) = True
                Else
                    Finished(4) = False
                End If
            End If
            
Skip_To_Here:
            
            'Used for debugging
            'Range("AA" & TempVar1).Value = Answers(1)
            'Range("AB" & TempVar1).Value = Answers(2)
            'Range("AC" & TempVar1).Value = Answers(3)
            'Range("AD" & TempVar1).Value = Answers(4)
            'Range("AE" & TempVar1).Value = Answers(5)
            'Range("AF" & TempVar1).Value = Answers(6)
            'Range("AG" & TempVar1).Value = Answers(7)
            'Range("AH" & TempVar1).Value = Answers(8)
            
            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
MsgBox "Answer not found"
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:
'Display the answers
Range("C1").Value = Answers(1)
Range("D2").Value = Answers(2)
Range("E3").Value = Answers(3)
Range("D4").Value = Answers(4)
Range("C5").Value = Answers(5)
Range("B4").Value = Answers(6)
Range("A3").Value = Answers(7)
Range("B2").Value = Answers(8)

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

Legacy 98055 · Oct 18, 2006

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 · Oct 18, 2006

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 · Oct 18, 2006

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 · Oct 19, 2006

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

For Fun and Learning Project

Legacy 98055

Guest

Excel Facts

SydneyGeek

MrExcel MVP

SydneyGeek

MrExcel MVP

Andrew Fergus

MrExcel MVP

Andrew Fergus

MrExcel MVP

Andrew Fergus

MrExcel MVP

Legacy 98055

Guest

Andrew Fergus

MrExcel MVP

SydneyGeek

MrExcel MVP

SydneyGeek

MrExcel MVP

Forum statistics

Share this page

For Fun and Learning Project

Legacy 98055

Guest

Excel Facts

MrExcel MVP

MrExcel MVP

MrExcel MVP

MrExcel MVP

MrExcel MVP

Legacy 98055

Guest

MrExcel MVP

MrExcel MVP

MrExcel MVP

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