A family of Microsoft spreadsheet software with tools for analyzing, charting, and communicating data.
This should work better. You can add more sections as needed.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Nothing Left to Lose - April 2018 and March 2021
If Not Application.Intersect(Me.Range("I407:J424"), Target) Is Nothing Then
'Escape from edit mode
Cancel = True
ProcessRange Target, Me.Range("I407:J424")
End If
If Not Application.Intersect(Me.Range("D407:E424"), Target) Is Nothing Then
'Escape from edit mode
Cancel = True
ProcessRange Target, Me.Range("D407:E424")
End If
End Sub
Private Sub ProcessRange(tgt As Range, rng As Range)
Dim rCell As Range
Application.ScreenUpdating = False
For Each rCell In rng
With rCell
If .Value = "" Then
.Font.Name = "Wingdings 2"
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = xlColorIndexNone
rCell.Value = "£"
.Font.Bold = False
End If
End With
Next rCell
'No controls used - faux checkboxes using "Wingdings 2" font.
'toggle Checkmarks
With tgt
If .Value = "£" Then
.Value = "R"
.Font.Bold = True
.Font.Color = 0 'Black
.Interior.Color = vbGreen
If Not Application.Intersect(tgt, rng.Columns(1)) Is Nothing Then
With .Offset(0, 1)
.Value = "£"
.Font.Bold = False
.Interior.ColorIndex = xlColorIndexNone
End With
Else
With .Offset(0, -1)
.Value = "£"
.Font.Bold = False
.Interior.ColorIndex = xlColorIndexNone
End With
End If
Else
.Value = "£"
.Font.Bold = False
.Interior.ColorIndex = xlColorIndexNone
End If
End With
Application.ScreenUpdating = True
End Sub