Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim d, dat As Date, i%
d = Array("B3", Array(4, 2, 4), Array(5, 2, 5), Array(6, 2, 6), Array(0, 2, 7), Array(1, 2, 8), Array(2, 2, 9), Array(3, 2, 10))
dat = Date
With Range(d(0))
For i = 1 To UBound(d)
With .Offset(, i - 1)
If Int(.Value) = dat + d(i)(0) Then .Font.ColorIndex = d(i)(1): .Offset(-1).Resize(3, 1).Interior.ColorIndex = d(i)(2)
End With
Next
End With
Cancel = True
End Sub