Conditional alternating loop

[W.J.Surrarrer]

I have the alternating loop functioning (code is ugly, see below), but
I don't know how to apply the condition and maintain the correct
CountWArt variable.
The condition is (If ActiveCell.Value = "" Then), skip this areas cell
and go to next areas cell without incrementing CountWArt. There is
delete all word art macro at the end of code for testing purposes. I'm
a beginner at this so any help will be appreciated, Thanks

Sub AddWordArt5()
Worksheets("Sheet1").Activate
Application.ScreenUpdating = False
Set BigRange = Application.Union(Range("G9:G13,N9:N13,U9:U13"), _
Range("G17:G21,N17:N21,U17:U21"), _
Range("G25:G29,N25:N29,U25:U29"), _
Range("G33:G37,N33:N37,U33:U37"))
Range("G9").Activate 'Select
''''''BigRangeCount = BigRange.Areas.Count
For Each Areas In BigRange
''''''For Count = 1 To BigRangeCount
Dim celTop As Long
celTop = ActiveCell.Top
Dim SH As Excel.Shape
'Alternates between text "A" and "B"
If fVBAIsEven(CountWArt) = True Then
Set SH = ActiveSheet.Shapes.AddTextEffect(TextEffect6,
_
"A", "Arial Black", 20#, _
False, False, 21.75, celTop)
End If
If fVBAIsEven(CountWArt) = False Then
Set SH = ActiveSheet.Shapes.AddTextEffect(TextEffect6,
_
"B", "Arial Black", 20#, _
False, False, 21.75, celTop)
End If
With SH
.Height = 25
.Width = 22
.Fill.Visible = True
.Fill.Solid
If .TextEffect.Text = "A" Then _
.Fill.ForeColor.SchemeColor = 10 '4 blue 10 Red
If .TextEffect.Text = "B" Then _
.Fill.ForeColor.SchemeColor = 4 '4 blue 10 Red
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = 1
.Line.Style = 1
.Line.Transparency = 0#
.Line.Visible = True
If .TextEffect.Text = "A" Then _
.Line.ForeColor.SchemeColor = 10 '4 blue 10 Red
If .TextEffect.Text = "B" Then _
.Line.ForeColor.SchemeColor = 4 '4 blue 10 Red
.Line.BackColor.RGB = RGB(255, 255, 255)
.LockAspectRatio = False
.ZOrder BringToFront
.Left = Selection.Left
.IncrementLeft 19
.IncrementTop 11
End With
'First row/column ranges
If CountWArt <= 3 Then
ActiveCell.Offset(1, 0).Activate
End If
If CountWArt = 4 Then
ActiveCell.Offset(-4, 7).Activate
End If
If CountWArt > 4 And CountWArt <= 8 Then
ActiveCell.Offset(1, 0).Activate
End If
If CountWArt = 9 Then
ActiveCell.Offset(-4, 7).Activate
End If
If CountWArt > 9 And CountWArt <= 13 Then
ActiveCell.Offset(1, 0).Activate
End If
'Second row/column ranges
If CountWArt = 14 Then
ActiveCell.Offset(4, -14).Activate
End If
If CountWArt > 14 And CountWArt <= 18 Then
ActiveCell.Offset(1, 0).Activate
End If
If CountWArt = 19 Then
ActiveCell.Offset(-4, 7).Activate
End If
If CountWArt > 19 And CountWArt <= 23 Then
ActiveCell.Offset(1, 0).Activate
End If
If CountWArt = 24 Then
ActiveCell.Offset(-4, 7).Activate
End If
If CountWArt > 24 And CountWArt <= 28 Then
ActiveCell.Offset(1, 0).Activate
End If
'Third row/column ranges
If CountWArt = 29 Then
ActiveCell.Offset(4, -14).Activate
End If
If CountWArt > 29 And CountWArt <= 33 Then
ActiveCell.Offset(1, 0).Activate
End If
If CountWArt = 34 Then
ActiveCell.Offset(-4, 7).Activate
End If
If CountWArt > 34 And CountWArt <= 38 Then
ActiveCell.Offset(1, 0).Activate
End If
If CountWArt = 39 Then
ActiveCell.Offset(-4, 7).Activate
End If
If CountWArt > 39 And CountWArt <= 43 Then
ActiveCell.Offset(1, 0).Activate
End If
'Fourth row/column ranges

If CountWArt = 44 Then
ActiveCell.Offset(4, -14).Activate
End If
If CountWArt > 44 And CountWArt <= 48 Then
ActiveCell.Offset(1, 0).Activate
End If
If CountWArt = 49 Then
ActiveCell.Offset(-4, 7).Activate
End If
If CountWArt > 49 And CountWArt <= 53 Then
ActiveCell.Offset(1, 0).Activate
End If
If CountWArt = 54 Then
ActiveCell.Offset(-4, 7).Activate
End If
If CountWArt > 54 And CountWArt <= 58 Then
ActiveCell.Offset(1, 0).Activate
End If

CountWArt = CountWArt + 1
Next Areas
''''''Next Count
Application.ScreenUpdating = True
End Sub

Function fVBAIsEven(ByVal lngNumber As Long) As Boolean
fVBAIsEven = (lngNumber \ 2 = lngNumber / 2)
End Function

'Deletes all WordArt from sheet
Sub DeleteWordArt()
Dim shp As Shape
Application.ScreenUpdating = False
For Each shp In ActiveSheet.Shapes
If Left(shp.Name, 7) = "WordArt" Then shp.Delete
Next shp
Application.ScreenUpdating = True
End Sub