Private Sub Calendar1_Click() If Intersect(ActiveCell, Range("A17:A26")) Is Nothing Then ActiveCell.Activate Exit Sub Else ActiveCell.Value = Calendar1.Value ActiveCell.Activate End If End Sub