23 Nov 2020

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.

 

Post a comment