Brain Game in Excel

The excel VBA code for the Brain Game in Excel. Read the related post here.

Global testval As Integer
Global tim As Integer
Global exitTime
Global working As Boolean
Global cnt(1 To 9) As Integer
Global clicked As Integer</code>

Sub test()

Dim ButtonText As String

If (Not working) Then Exit Sub

ButtonText = Application.Caller

k = ActiveSheet.Shapes(ButtonText).TopLeftCell
Cells(10, 1) = k

If (k = testval) Then
clicked = clicked + 1
ActiveSheet.Shapes(ButtonText).Fill.ForeColor.RGB = RGB(128, 0, 0)
ActiveSheet.Shapes(ButtonText).Fill.Transparency = 0
If (clicked = cnt(testval)) Then
working = False
Call nextitem
End If
Else
working = False
End If

End Sub

Sub cleanandstop()
working = False
Call ClearBars
Cells(8, 1) = ""
Cells(10, 1) = ""

End Sub

Sub inishape()

Set myDocument = ActiveSheet
For Each sh In myDocument.Shapes
If sh.Type = msoAutoShape Then
sh.Fill.ForeColor.RGB = RGB(0, 0, 0)
sh.Fill.Transparency = 1#
End If
Next

End Sub

Sub run()
tim = 0
Application.OnTime Now + TimeValue("00:00:01"), "settim"

End Sub

Sub init()
Set Rng = Range("a1:j5")
Call inishape
Call ClearBars
working = True
Application.Calculate
testval = Application.WorksheetFunction.RandBetween(1, 6)

cnt(1) = Application.WorksheetFunction.SumIf(Rng, "=1")
cnt(2) = Application.WorksheetFunction.SumIf(Rng, "=2") / 2
cnt(3) = Application.WorksheetFunction.SumIf(Rng, "=3") / 3
cnt(4) = Application.WorksheetFunction.SumIf(Rng, "=4") / 4
cnt(5) = Application.WorksheetFunction.SumIf(Rng, "=5") / 5
cnt(6) = Application.WorksheetFunction.SumIf(Rng, "=6") / 6
cnt(7) = Application.WorksheetFunction.SumIf(Rng, "=6") / 7
cnt(8) = Application.WorksheetFunction.SumIf(Rng, "=6") / 8
cnt(9) = Application.WorksheetFunction.SumIf(Rng, "=6") / 9

Cells(1, 12) = testval
tim = 0
Call settim
End Sub

Sub nextitem()
tim = 0
Call ClearBars
testval = Application.WorksheetFunction.RandBetween(1, 9)
Cells(1, 12) = testval
working = True
End Sub

Sub stp()
Call inishape
Call ClearBars
testval = Application.WorksheetFunction.RandBetween(1, 9)
Cells(1, 12) = testval

End Sub

Sub settim()
tim = tim + 1
If (tim &gt; 10) Then
tim = 0
Call stp
End If
Cells(8, 1) = tim
If (tim &lt;&gt; 0) Then Call ChangeShape(tim)
If (working) Then
exitTime = Now + TimeValue("00:00:01")
Application.OnTime exitTime, "settim"
End If

End Sub

Sub ChangeShape(num)
Cells(8, num).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.4
.PatternTintAndShade = 0
End With
End Sub

Sub ClearBars()

Range("A8:Z8").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Cells(1, 12).Select
End Sub



Click to download the excel file and play

One thought on “Brain Game in Excel

  1. Pingback: An Excel App for Your Brain! | SukhbinderSingh.com

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s