Do merged cells irritate you? My latest lame game gives you points for whacking merged cells!
Excel File
Download it here!. NOTE: file contains macros (vba)
Merged Cells
They are such a pain and cause so many problems. …they’re also a bit intriguing.
This VBA turns range ‘MergedCellRange’ into a merged cell:
MergedCellRange.Activate
With Selection
.MergeCells = True
End With
Why create more? I had to simulate what your work colleagues do to you.
The Game
Have you played Whack-A-Mole? That’s the concept I’ve used. Your task is to whack (click) merged cells without clicking cells that aren’t merged. Click the mallet button to add merged cells.
Gain points for whacking merged cells. Lose points for whacking non merged cells.
It becomes a memory game trying to remember where the new merged cells are located.
If you keep clicking the mallet without whacking any cells then my code misbehaves 🙁 something about merged cells merging with other merged cells maybe?
Practice VBA
Yes it’s lame but it gave me the chance to practice vba. It includes set, loop, event code, rnd(), etc.
Set
This creates a merged cell with some size variation (full code ‘Create Merged Cells’ further down).
Set MergedCellRange = Range(Cells(randr1, randc1), Cells(randr2, randc2))
Loop
A For Next loop to create up to 3 merged cells each time you click the mallet.
For X = 1 To LoopC
Event Code
Includes a toggle switch. When named range EventCodeSwitch is set to “yes” the code is turned off.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
‘TOGGLE THIS EVENT CODE OFF/ON
If Range(“EventCodeSwitch”).Value = “yes” Then Exit Sub
‘IF CLICKED CELL OUTSIDE RANGE THEN EXIT
If ActiveCell.Column > 46 Then Exit Sub
If ActiveCell.Row > 42 Then Exit Sub
‘IF CELL IS MERGED THEN…
If ActiveCell.MergeCells Then
‘UNMERGES EACH SELECTED MERGED CELL
With Selection
.MergeCells = False
End With
‘INCREASE SCORE: Merged Cells Clicked
Range(“BA20”).Value = Range(“BA20”).Value + 1
Else
‘INCREASE SCORE: Unmerged Cells Clicked
Range(“BA25”).Value = Range(“BA25”).Value + 1
End If
End Sub
Create Merged Cells
And finally the code to create the merged cells.
Sub CREATEMERGEDCELL()
Dim randr1 As Integer, randc1 As Integer, randr2 As Integer, randc2 As Integer, randx As Integer
Dim MergedCellRange As Range, actM As Range, LoopC As Integer
LoopC = 3
Application.ScreenUpdating = False
Range(“BA16”).Value = Range(“BA16”).Value + LoopC
For X = 1 To LoopC
‘Assign random values to the variables
randx1 = Int((5 – 1 + 1) * Rnd + 1)
randx2 = Int((4 – 1 + 1) * Rnd + 1)
randc1 = Int((34 – 1 + 1) * Rnd + 1)
randr1 = Int((37 – 1 + 1) * Rnd + 1)
randc2 = randc1 + randx1
randr2 = randr1 + randx2
‘CREATE MERGED CELL RANGE
Set MergedCellRange = Range(Cells(randr1, randc1), Cells(randr2, randc2))
‘SELECT AND MERGE CELLS
MergedCellRange.Activate
With Selection
.MergeCells = True
End With
MergedCellRange.Interior.Color = RGB(Int(Rnd() * 150), Int(Rnd() * 150), Int(Rnd() * 150))
Next X
Range(“BA25”).Value = Range(“BA25”).Value – LoopC
Range(“BA42”).Activate
Application.ScreenUpdating = True
End Sub
Most Excel fans will spend more time playing with the code as that’s more fun!
About Me
I’m a Data Analyst living in Markham Ontario Canada.
Microsoft Excel is still my favorite software despite all the new software out there these days.
There’s always something new to learn or old to practice in Excel.