Macro To Run Automatically On Date

Each worksheet has 4 days on it.. and there are 4 worksheets per month ( Jan1, Jan2, Jan3, Jan4 ). I have this macro which runs ( dependant on password ) to lock all cells so they cannot be edited after. On this macro I have to enter the month to lock and it adds on the 1,2,3,4.

Sub LockCell()
Dim i As Integer
Dim ws As Worksheet
Const Pass = "password"
Dim InptPass As String
Dim Mnth As String

On Error Resume Next

InptPass = InputBox("Please Enter Password")

If InptPass <> Pass Then
MsgBox "Incorrect Password", vbCritical
Exit Sub
Else...