Option Explicit
Dim C As Range, X As Range
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
If Not Application.Intersect(Target, Range("B44:B47,B51:B58")) Is Nothing Then
Cancel = True
Target = IIf(Target = "o", "þ", "o")
For Each C In Range("B51:B60")
For Each X In Range("Tab")
If C.Offset(, 1).Value = X.Value Then
X.Interior.ColorIndex = IIf(C = "o", xlNone, C.Offset(, 1).Interior.ColorIndex)
X.Font.ColorIndex = IIf(C = "o", 2, 0)
End If
Next X
Next C
End If
If Not Application.Intersect(Target, Range("B41")) Is Nothing Then
Cancel = True
For Each C In Range("B44:B47,B51:B58")
C = "þ"
Target.Offset(1, 0) = "o"
Target = "þ"
Next C
For Each C In Range("B51:B60")
For Each X In Range("Tab")
If C.Offset(, 1).Value = X.Value Then
X.Interior.ColorIndex = IIf(C = "o", xlNone, C.Offset(, 1).Interior.ColorIndex)
X.Font.ColorIndex = IIf(C = "o", 2, 0)
End If
Next X
Next C
End If
If Not Application.Intersect(Target, Range("B42")) Is Nothing Then
Cancel = True
For Each C In Range("B44:B47,B51:B60")
C = "o"
Target.Offset(-1, 0) = "o"
Target = "þ"
Next C
For Each C In Range("B51:B60")
For Each X In Range("Tab")
If C.Offset(, 1).Value = X.Value Then
X.Interior.ColorIndex = IIf(C = "o", xlNone, C.Offset(, 1).Interior.ColorIndex)
X.Font.ColorIndex = IIf(C = "o", 2, 0)
End If
Next X
Next C
End If
Application.ScreenUpdating = True
End Sub