Ho do we solve this mathmatical puzzle

G

Garry

This solving of this gem of a number puzzle is a just a
bit of fun but is something that my colleagues and I try
to complete every day from a National newspaper. The
premise is simple, you are presented with a grid (9x9
cells) that is made up of 9 sub grids (3x3 cells). The
idea is to complete the grid so that each sub grid
contains the numbers 1-9; each row (9 rows) must also
contain the nos 1-9) and each column (cols) must also
contain the nos 1-9. The paper provides cleverly placed
numbers to help you get started. More often than not the
puzzle beats us during our lunch hour. We have been
trying to solve this using Excel but to be honest we don't
know where to start. Can anyone provide us with
pointers/solutions as to where we would would start, if
possible, so as to stop us scratching our heads sore every
day.

Here is a sample puzzle. Good luck and have fun...

Garry
Col1 Col2 Col3 Col4 Col5 Col6
Col7 Col8 Col9
Row1 2 8 1 7
4
Row2 7 3 1

Row3 9 2 8
5
Row4 9 4
8 7
Row5 4 2 8
3
Row6 1 6 3 2

Row7 3 2 7
6
Row8 5 6
8
Row9 7 6 5 1
9
 
K

keepITcool

Garry,
Good luck and have fun...

Luck?.. nope.. it's (really rather basic) programming and analytical
skills and in fact there's no math to this at all.

it's just a straightforward elimination.. which is a lot easier to
achieve in VBA then it would be in (iterating) Excel functions..

and yes I had fun. Which you'll have no more... hence the naming of the
procedure <VBG>



Sub KillJoy()
Dim rData As Range, rCell As Range, rArea(1 To 3) As Range
Dim vFreq, vBins
Dim r33&, c33&, i&, j&, n&, l&

Set rData = ActiveWindow.RangeSelection

If rData.Rows.Count <> 9 Or rData.Columns.Count <> 9 Then
MsgBox "Select a 9x9 range..THEN run this macro"
Exit Sub
ElseIf Time < #1:30:00 PM# Then
MsgBox "Wait till after lunch"
Exit Sub
End If

'The BIN array for the frequency (could be 1 shorter)
vBins = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)

Do
For Each rCell In rData.SpecialCells(xlCellTypeBlanks)
'The row
Set rArea(1) = Intersect(rData, rCell.EntireRow)
'The col
Set rArea(2) = Intersect(rData, rCell.EntireColumn)
'The 3x3
r33 = rCell.Row - rData.Row + 1 - (( _
rCell.Row - rData.Row) Mod 3)
c33 = rCell.Column - rData.Column + 1 - (( _
rCell.Column - rData.Column) Mod 3)
Set rArea(3) = rData(r33, c33).Resize(3, 3)
'Get the counts
With Application
vFreq = .Transpose(.Frequency(Union(rArea(1), _
rArea(2), rArea(3)), vBins))
End With

'Find a unique count of zero
n = 0
For i = 1 To 9
If vFreq(i) = 0 Then
j = i
n = n + 1
End If
Next
'If found, eliminate
If n = 1 Then rCell = j

Next
l = l + 1
j = Application.CountBlank(rData)
Loop Until j = 0 Or l = 16

If j = 0 Then MsgBox "solved!" Else MsgBox "unsolvable?"

End Sub
 
G

Garry

Very, very impressive.
We were trying to use Solver and hadn't even considered
VBA - not that we could come up with a solution as elegant
as yours. KillJoy will only be used as a last resort,
i.e. at 12.59 if we can't solve the puzzle of the day.

Many thanks from all of us for your time and expertise -
no more serious head scratching now!

Garry
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top