Macro for Schulte Table

[Korien]

I am trying to setup macro for a Schulte Table.
I have a cell range with 25 cells numbered 1 to 25.
I'd like to be able to select all cells in ascending order
so when the first cell is selected a hidden stopwatch starts
and next cell if selected correctly flashes lightly to indicate its right.
After all the cells selected correctly would like recorded time to show up.

 

[wideboydixon]

Right click the sheet name, select View Code and paste the following:

Private nextNumber As Long
Private lastNumber As Long
Private startTime As Date
Private totalTime As Date
Private previousCell As Range
Public Sub SetUpSchulteTable(rowCount As Long, columnCount As Long, firstCell As Range)

Dim i As Long
Dim j As Long
Dim k As Long

For i = 0 To rowCount - 1
    For j = 0 To columnCount - 1
        firstCell.Offset(i, j).Value = i * rowCount + j + 1
    Next j
Next i

nextNumber = 1
lastNumber = rowCount * columnCount
Set previousCell = firstCell

Randomize
For i = 0 To lastNumber - 1
    j = Int(Rnd * lastNumber)
    k = firstCell.Offset(i Mod columnCount, Int(i / rowCount)).Value
    firstCell.Offset(i Mod columnCount, Int(i / rowCount)).Value = firstCell.Offset(j Mod columnCount, Int(j / rowCount)).Value
    firstCell.Offset(j Mod columnCount, Int(j / rowCount)).Value = k
Next i

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then Exit Sub
If previousCell Is Nothing Then Exit Sub
If nextNumber = 0 Then Exit Sub

If Target.Value = nextNumber Then
    If nextNumber = 1 Then startTime = Now
    previousCell.Interior.ColorIndex = xlColorIndexNone
    Target.Interior.Color = RGB(192, 255, 192)
    If nextNumber = lastNumber Then
        totalTime = Now - startTime
        MsgBox totalTime * 24 * 60 * 60 & " seconds", vbInformation + vbOKOnly, "Schulte Table"
        Target.Interior.ColorIndex = xlColorIndexNone
        nextNumber = 0
    Else
        Set previousCell = Target
        nextNumber = nextNumber + 1
        Debug.Print nextNumber
    End If
End If

End Sub
Public Sub SetUp5x5Table()

Me.SetUpSchulteTable 5, 5, Range("$A$1")

End Sub

Back on the sheet, press Alt+F8 and run the SetUp5x5Table macro. Then start clicking the numbers ...

WBD

 

[Korien]

Thank you this is awesome job

Can the cell flash with a quick white fade in/out effect when correct cell selection is made

 

[wideboydixon]

Cells don't really flash in Excel. Something could be done but it's becomes much more complex and error-prone. For now, the correct selection is shown with a green background.

WBD

 

[Korien]

xlColorIndexNone turns the cell white

Is it possible to return the original fill color of the cell before it was selected?

 

[wideboydixon]

Sure. You can change xlColorIndexNone to another value from the color palette or you can set the RGB value manually as elsewhere in the code.

WBD

 

[Korien]

All the cells have random colors when the worksheet is opened, but the code turns them white after selection.
I am not certain how to amend the code to return the preexisting cell background color that was there before the cell is selected.
I was hoping there would be a variation of xlColorIndexNone how to obtain original color value and return the original background color instead of white.

 

[Korien]

The macro works perfectly the way you originally designed it, thanks again WBD.

 

[wideboydixon]

This should restore the color as necessary:

Private nextNumber As Long
Private lastNumber As Long
Private startTime As Date
Private totalTime As Date
Private previousCell As Range
Private previousCellColor As Variant
Public Sub SetUpSchulteTable(rowCount As Long, columnCount As Long, firstCell As Range)

Dim i As Long
Dim j As Long
Dim k As Long

For i = 0 To rowCount - 1
    For j = 0 To columnCount - 1
        firstCell.Offset(i, j).Value = i * rowCount + j + 1
    Next j
Next i

nextNumber = 1
lastNumber = rowCount * columnCount
Set previousCell = firstCell
previousCellColor = GetCellColor(previousCell)

Randomize
For i = 0 To lastNumber - 1
    j = Int(Rnd * lastNumber)
    k = firstCell.Offset(i Mod columnCount, Int(i / rowCount)).Value
    firstCell.Offset(i Mod columnCount, Int(i / rowCount)).Value = firstCell.Offset(j Mod columnCount, Int(j / rowCount)).Value
    firstCell.Offset(j Mod columnCount, Int(j / rowCount)).Value = k
Next i

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then Exit Sub
If previousCell Is Nothing Then Exit Sub
If nextNumber = 0 Then Exit Sub

If Target.Value = nextNumber Then
    If nextNumber = 1 Then startTime = Now
    SetCellColor previousCell, previousCellColor
    previousCellColor = GetCellColor(Target)
    SetCellColor Target, RGB(192, 255, 192)
    If nextNumber = lastNumber Then
        totalTime = Now - startTime
        MsgBox totalTime * 24 * 60 * 60 & " seconds", vbInformation + vbOKOnly, "Schulte Table"
        SetCellColor Target, previousCellColor
        nextNumber = 0
    Else
        Set previousCell = Target
        nextNumber = nextNumber + 1
    End If
End If

End Sub
Private Function GetCellColor(thisCell As Range) As Variant

If thisCell.Interior.ColorIndex = xlColorIndexNone Then
    GetCellColor = xlColorIndexNone
Else
    GetCellColor = thisCell.Interior.Color
End If

End Function
Private Sub SetCellColor(thisCell As Range, thisColor As Variant)

If thisColor = xlColorIndexNone Then
    thisCell.Interior.ColorIndex = xlColorIndexNone
Else
    thisCell.Interior.Color = thisColor
End If

End Sub
Public Sub SetUp5x5Table()

Me.SetUpSchulteTable 5, 5, Range("$A$1")

End Sub

WBD