'=================================================================================
'- MACRO TO ENTER DATES INTO A RANGE OF CELLS USING THE CALENDAR CONTROL
'=================================================================================
'- (Open the Controls Toolbox, Click "More Controls",
'- Select "Calendar Control" & draw on the sheet)
'- Set the Visible property to False
'- This code goes into the Worksheet module (right click tab/View Code)
'-
'- Brian Baulsom July 2007 using Excel 2000
'=================================================================================
'=================================================================================
'- SHEET : DOUBLE CLICK SHEET CELL B2 TO RUN THE CALENDAR CONTROL
'=================================================================================
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address = "$B$2" Then
With Calendar1
.Top = Range("B2").Top + 10 ' calendar position
.Left = Range("D4").Left
.Visible = True
End With
'------------------------------------------------------------------------
'- clear date cells
Range("B3:B11").ClearContents
With Range("B3")
.Interior.ColorIndex = 6 ' highlight cell
.Select
End With
End If
End Sub
'--------------------------------------------------------------------------------
'================================================================================
'- CALENDAR : CLICK DAY TO INSERT DATE
'- NB. This runs from the beginning when the Calendar is clicked
'================================================================================
Private Sub Calendar1_Click()
Dim DateCount As Integer
Dim n, rw
Dim MyCell As Range
DateCount = ActiveSheet.Range("B2").Value
'---------------------------------------------------------------------------
'- find next empy cell
For n = 1 To DateCount
rw = n + 2
Set MyCell = ActiveSheet.Cells(rw, 2)
'-
With MyCell
If CStr(.Value) = "" Then
.Value = Calendar1.Value
'---------------------------------------------
'- change highlight. Select next cell
.Interior.ColorIndex = xlNone
If n < DateCount Then
.Offset(1, 0).Interior.ColorIndex = 6
.Offset(1, 0).Select
End If
'---------------------------------------------
If DateCount = 1 Then Calendar1.Visible = False
Exit Sub
End If
End With
'----------------------------------------------------------------------
'- All cells entred. Hide Calendar Control again
If n = DateCount - 1 Then Calendar1.Visible = False
Next
End Sub
'-----------------------------------------------------------------------------------