Search:

# Macro for One-Solution Puzzle

Asked By: Harry    Date: Oct 19    Category: MS Office    Views: 2666

I have always been able to record a procedure.
But this time, no matter how many times I have tried,
it seems the procedure cannot be recorded.

There is this simple logic puzzle, involving the

The problem is that sometimes it has multiple
solutions. I want it to have only ONE solution.

The puzzle is a 10 x 10 square, and they solve
the puzzle by making sure that each column and
each row has no more than one instance of the
letters, say, A, B, C, D, E, F, G, H, I, and J.

I want to create a procedure that can test-solve
the puzzle using logic, in a one-solution way.

Instructions for Procedure:
-----------------------------------------------------------

Removing Letters from Some Cells to Create the
Puzzle
-------------------------------------------------
1. First, in the Range("A2:J31"), delete the contents
of the cells whose interior color is white.

2. Using Logic to Fill the Empty Cells with Letters to
Solve the Puzzle.
---------------------------------------------------
In keeping with remaining letters in their
respective cells, use logic to fill in the empty
cells such that each column and each row has no
more than one instance of the letters A, B, C, D,
E, F, G, H, I, and J.

3. Display a message if a puzzle is not solvable or
solvable but does not have one solution.

4. Display no message if a puzzle is solvable and
does have only ONE solution.

Below are the columns and rows and the cell names
of I am using for the puzzle, starting with the
first row and the first column and so on:
-----------------------------------------------------------
A2:A4|B2:B4|C2:C4|D2:D4|E2:E4|F2:F4|G2:G4|H2:H4|I2:I4|J2:J4
-----------------------------------------------------------
A5:A7|B5:B7|C5:C7|D5:D7|E5:E7|F5:F7|G5:G7|H5:H7|I5:I7|J5:J7
-----------------------------------------------------------
A8:A10|B8:B10|C8:C10|D8:D10|E8:E10|F8:F10|G8:G10|H8:H10|I8:I10|J8:J10
---------------------------------------------------------------------
A11:A13|B11:B13|C11:C13|D11:D13|E11:E13|F11:F13|G11:G13|H11:H13|I11:I13|J11:J13
-------------------------------------------------------------------------------
A14:A16|B14:B16|C14:C16|D14:D16|E14:E16|F14:F16|G14:G16|H14:H16|I14:I16|J14:J16
-------------------------------------------------------------------------------
A17:A19|B17:B19|C17:C19|D17:D19|E17:E19|F17:F19|G17:G19|H17:H19|I17:I19|J17:J19
-------------------------------------------------------------------------------
A20:A22|B20:B22|C20:C22|D20:D22|E20:E22|F20:F22|G20:G22|H20:H22|I20:I22|J20:J22
-------------------------------------------------------------------------------
A23:A25|B23:B25|C23:C25|D23:D25|E23:E25|F23:F25|G23:G25|H23:H25|I23:I25|J23:J25
-------------------------------------------------------------------------------
A26:A28|B26:B28|C26:C28|D26:D28|E26:E28|F26:F28|G26:G28|H26:H28|I26:I28|J26:J28
-------------------------------------------------------------------------------
A29:A31|B29:B31|C29:C31|D29:D31|E29:E31|F29:F31|G29:G31|H29:H31|I29:I31|J29:J31
-------------------------------------------------------------------------------

Share:

Your puzzle  is similar to a Sudoku puzzle. Andy Pope has a downloadable Excel
file which can create  and solve Sudoku puzzles. You might be able to adapt it
for your needs. You can find it at: http://www.andypope.info/fun/sudoku.htm

I have been trying to adapt it,
but I keep getting error messages.

I will keep trying...

So far I have been able to generate
the macro  that creates the puzzle.

But I need with coming up with 3 other macros.

One of the 3 macros is a macro that will find
and delete  the contents of those cells  below
whose background color(fill-color) is white:

-----------------------------------------------------------
A2:A4|B2:B4|C2:C4|D2:D4|E2:E4|F2:F4|G2:G4|H2:H4|I2:I4|J2:J4
-----------------------------------------------------------
A5:A7|B5:B7|C5:C7|D5:D7|E5:E7|F5:F7|G5:G7|H5:H7|I5:I7|J5:J7
-----------------------------------------------------------
A8:A10|B8:B10|C8:C10|D8:D10|E8:E10|F8:F10|G8:G10|H8:H10|I8:I10|J8:J10
---------------------------------------------------------------------
A11:A13|B11:B13|C11:C13|D11:D13|E11:E13|F11:F13|G11:G13|H11:H13|I11:I13|J11:J13
-------------------------------------------------------------------------------
A14:A16|B14:B16|C14:C16|D14:D16|E14:E16|F14:F16|G14:G16|H14:H16|I14:I16|J14:J16
-------------------------------------------------------------------------------
A17:A19|B17:B19|C17:C19|D17:D19|E17:E19|F17:F19|G17:G19|H17:H19|I17:I19|J17:J19
-------------------------------------------------------------------------------
A20:A22|B20:B22|C20:C22|D20:D22|E20:E22|F20:F22|G20:G22|H20:H22|I20:I22|J20:J22
-------------------------------------------------------------------------------
A23:A25|B23:B25|C23:C25|D23:D25|E23:E25|F23:F25|G23:G25|H23:H25|I23:I25|J23:J25
-------------------------------------------------------------------------------
A26:A28|B26:B28|C26:C28|D26:D28|E26:E28|F26:F28|G26:G28|H26:H28|I26:I28|J26:J28
-------------------------------------------------------------------------------
A29:A31|B29:B31|C29:C31|D29:D31|E29:E31|F29:F31|G29:G31|H29:H31|I29:I31|J29:J31
-------------------------------------------------------------------------------

Could you help me with that?

It looks as though you would need to create  a for/next loop that went through
each cell  in the range A2:J31, if the Cell.Interior is White the cell.value is

<<It looks as though you would need to create  a for/next
loop that went through each cell  in the range A2:J31,
if the Cell.Interior is White the cell.value is "">>
David Grugeon

Is it possible to create a for/next loop
through recording? So far no luck...

All my excel/vba macros i create
them by recording my actions.

No, You will need to type the code in. type For then press F1 and look at the
help screen. look at the For each ... next

You will end up with something like (untested)
Option Explicit

Sub fixit()
Dim myrange As Range
Dim c As Range

Set myrange = ActiveSheet.Range("A1:Z24")

For Each c In myrange
If c.Interior.Color = vbWhite Then
c.Font.Bold = True
End If
Next c
End Sub

Try the following macro:

Sub DelIfWhiteBkgrd(Rng As Range)
Dim c As Range
For Each c In Rng
'If cell  background is white  or has no fill,
'clear the cell's contents.
If (c.Interior.ColorIndex = 2 Or _
c.Interior.ColorIndex = xlNone) Then
c.ClearContents
End If
Next c
End Sub

You call it like this, as needed:

Sub AAAA()
Call DelIfWhiteBkgrd(ActiveSheet.Range("A2:J31"))
End Sub

It works like magic.

The next macro  I need is one that will test-solve the puzzle  to
ensure that the puzzle is solvable and has a unique solution,
checking and logically filling the empty cells  with the letters
A through J (A, B, C, D, E, F, G, H, I, J), going by the rule
of the puzzle that the letters  A through J appear exactly
once in each row  and column, no letter appearing more than once.

In other words, when the macro fills an empty  cell with a letter,
it does so because no other letter can logically go into that empty cell.

If the puzzle is not solvable using logic  or it is solvable using
logic but it does not have a unique solution  - having multiple
solutions, the macro is to call another macro named StartOver.

When the puzzle is solvable and has a unique solution, the message
"Solvable & Unique" is to be displayed momentarily - a second or two.

By the way, the macro mentioned above - "StartOver," which I have
already been able to create  through recording (you guessed
right...(-:) - deletes the cell  contents and calls the macro that I
need here, the one that will test- solve the puzzle to find a unique
solution.

Listed below are the 10x10 rows  and columns, with the cell names,
that are used for the puzzle.

----------------------------------------------------------
A2:A4|B2:B4|C2:C4|D2:D4|E2:E4|F2:F4|G2:G4|H2:H4|I2:I4|J2:J4
----------------------------------------------------------
A5:A7|B5:B7|C5:C7|D5:D7|E5:E7|F5:F7|G5:G7|H5:H7|I5:I7|J5:J7
----------------------------------------------------------
A8:A10|B8:B10|C8:C10|D8:D10|E8:E10|F8:F10|G8:G10|H8:H10|I8:I10|J8:J10
----------------------------------------------------------
A11:A13|B11:B13|C11:C13|D11:D13|E11:E13|F11:F13|G11:G13|H11:H13|I11:I13|J11:J13
----------------------------------------------------------
A14:A16|B14:B16|C14:C16|D14:D16|E14:E16|F14:F16|G14:G16|H14:H16|I14:I16|J14:J16-\
\
---------------------------------------------------------
A17:A19|B17:B19|C17:C19|D17:D19|E17:E19|F17:F19|G17:G19|H17:H19|I17:I19|J17:J19
----------------------------------------------------------
A20:A22|B20:B22|C20:C22|D20:D22|E20:E22|F20:F22|G20:G22|H20:H22|I20:I22|J20:J22
----------------------------------------------------------
A23:A25|B23:B25|C23:C25|D23:D25|E23:E25|F23:F25|G23:G25|H23:H25|I23:I25|J23:J25
----------------------------------------------------------
A26:A28|B26:B28|C26:C28|D26:D28|E26:E28|F26:F28|G26:G28|H26:H28|I26:I28|J26:J28
----------------------------------------------------------
A29:A31|B29:B31|C29:C31|D29:D31|E29:E31|F29:F31|G29:G31|H29:H31|I29:I31|J29:J31
----------------------------------------------------------

Didn't find what you were looking for? Find more on Macro for One-Solution Puzzle Or get search suggestion and latest updates.