need help to build macro

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Sort by date Sort by votes
Hi Neo,

I note from your file you are using a Worksheet change event.

I think you will find your problem easier to solve if you break it down. Don't try to do everything in the worksheet change event. Instead, use it to monitor what has changed and call the appropriate procedure.

Let me explain.

First I would force the user to change only one cell at a time:
Change Event
Code: 
[COLOR=green]'====================================[/COLOR]
   [COLOR=green]'Has more than one cell been changed?[/COLOR]
   [COLOR=green]'====================================[/COLOR]
   [COLOR=darkblue]If[/COLOR] Target.Cells.Count > 1 [COLOR=darkblue]Then[/COLOR]
      MsgBox "Please enter codes one at a time!", vbInformation
      Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
      [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]

You also want to check if the date has been changed, if so clear the previous contents of that particular row.
Change Event
Code: 
   [COLOR=green]'====================[/COLOR]
   [COLOR=green]'has the date changed[/COLOR]
   [COLOR=green]'====================[/COLOR]
   [COLOR=darkblue]If[/COLOR] Target.Column = 8 [COLOR=darkblue]Then[/COLOR]
      lngRow = Target.Row
      dteEmpStart = Format(Target.Value, "mm/dd/yyyy")
      [COLOR=red]Call[/COLOR] [COLOR=red]ProcessDateChange[/COLOR](lngRow, dteEmpStart)
      Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
      [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]

Note the call to a procedure to process a start date change. This procedure clears the previous contents of the row:
Code: 
[COLOR=darkblue]Sub[/COLOR] [COLOR=red]ProcessDateChange[/COLOR]([COLOR=darkblue]ByVal[/COLOR] myRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], _
                      [COLOR=darkblue]ByVal[/COLOR] myDate [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Date[/COLOR])
[COLOR=green]'==============================================[/COLOR]
[COLOR=green]'for a new employee clear previous row contents[/COLOR]
[COLOR=green]'==============================================[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] dteRecStart [COLOR=darkblue]As[/COLOR] Date  [COLOR=green]'records start date "N17"[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] iDateDiff [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]    [COLOR=green]'difference between empStart and RecStart dates[/COLOR]
Stop
   dteRecStart = Format(Range("N17"), "mm/dd/yyyy")
   iDateDiff = DateDiff("d", dteRecStart, myDate)
   Range(Cells(myRow, 14), Cells(myRow, 14 + iDateDiff)).ClearContents
   Range("L" & myRow).Value = 10   [COLOR=green]'reset the sickness count[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

The next thing you want the change event to check is if the user entered a code, again note the Call to a procedure to handle this event:
Change Event
Code: 
   [COLOR=green]'========================[/COLOR]
   [COLOR=green]'has a code been entered?[/COLOR]
   [COLOR=green]'========================[/COLOR]
[COLOR=green]'Stop[/COLOR]
   [COLOR=darkblue]If[/COLOR] Target.Column >= 14 [COLOR=darkblue]Then[/COLOR]
      sCode = UCase(Target.Value)
      lngRow = Target.Row
      [COLOR=red]Call ProcessCode[/COLOR](sCode, lngRow)
      [COLOR=green]'check to see if no more sick days allowed[/COLOR]
      [COLOR=darkblue]If[/COLOR] Range("L" & lngRow).Value = 0 [COLOR=darkblue]Then[/COLOR] Target.Value = "SU"
      [COLOR=green]'Call CheckCumulativeSickDays[/COLOR]
      Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
      [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]

The Process Code procedure being:
Code: 
[COLOR=darkblue]Sub[/COLOR] [COLOR=red]ProcessCode[/COLOR]([COLOR=darkblue]ByVal[/COLOR] myCode [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], _
                   [COLOR=darkblue]ByVal[/COLOR] myRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR])
[COLOR=green]'=====================================[/COLOR]
[COLOR=green]'process the code entered by the user[/COLOR]
[COLOR=green]'=====================================[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] iSickCount [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
Stop
   [COLOR=darkblue]Select[/COLOR] [COLOR=darkblue]Case[/COLOR] myCode
      [COLOR=darkblue]Case[/COLOR] "D":
         [COLOR=darkblue]Call[/COLOR] msgD
      [COLOR=darkblue]Case[/COLOR] "M":
         [COLOR=darkblue]Call[/COLOR] msgM
      [COLOR=darkblue]Case[/COLOR] [COLOR=darkblue]Else[/COLOR]
         [COLOR=green]'code "S" has been entered[/COLOR]
         iSickCount = [COLOR=darkblue]CLng[/COLOR](Range("L" & myRow).Value)
         [COLOR=darkblue]If[/COLOR] iSickCount = 0 [COLOR=darkblue]Then[/COLOR]
            [COLOR=darkblue]Call[/COLOR] msgS
         [COLOR=darkblue]Else[/COLOR]
            [COLOR=green]'decrease the sickness count[/COLOR]
            iSickCount = iSickCount - 1
            Range("L" & myRow).Value = iSickCount
         [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Select[/COLOR]
End [COLOR=darkblue]Sub[/COLOR]

Some cases above merely call a message procedure.

Your code also includes what appears to a calculation for cumulative Sickness days. I would isolate this into its own procedure and call it from the change event. I have placed a commented out Call to where you would place this in the code.

I have left the Stop commands in place. When the code stops at this line press F8 to step through each line. This will give you a better understanding of what the code does.

Make a copy of your file to test the code.

The full code is below, note how the change event is more compact and it gives you a better feel of what you are trying to acheive.
Code: 
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Worksheet_Change([COLOR=darkblue]ByVal[/COLOR] Target [COLOR=darkblue]As[/COLOR] Range)
   [COLOR=darkblue]Dim[/COLOR] lngRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]            [COLOR=green]'target row[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] sCode [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]           'code entered by user
   [COLOR=darkblue]Dim[/COLOR] dteEmpStart [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Date[/COLOR]       [COLOR=green]'employee start date[/COLOR]
 
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] errHandler
   Application.EnableEvents = [COLOR=darkblue]False[/COLOR] [COLOR=green]'prevent change event from re-triggering[/COLOR]
   [COLOR=green]'====================================[/COLOR]
   [COLOR=green]'Has more than one cell been changed?[/COLOR]
   [COLOR=green]'====================================[/COLOR]
   [COLOR=darkblue]If[/COLOR] Target.Cells.Count > 1 [COLOR=darkblue]Then[/COLOR]
      MsgBox "Please enter codes one at a time!", vbInformation
      Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
      [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
   [COLOR=green]'========================[/COLOR]
   [COLOR=green]'has a code been entered?[/COLOR]
   [COLOR=green]'========================[/COLOR]
   [COLOR=darkblue]If[/COLOR] Target.Column >= 14 [COLOR=darkblue]Then[/COLOR]
      sCode = UCase(Target.Value)
      lngRow = Target.Row
      [COLOR=darkblue]Call[/COLOR] ProcessCode(sCode, lngRow)
      [COLOR=green]'check to see if no more sick days allowed[/COLOR]
      [COLOR=darkblue]If[/COLOR] Range("L" & lngRow).Value = 0 [COLOR=darkblue]Then[/COLOR] Target.Value = "SU"
      [COLOR=green]'[COLOR=red]Call [/COLOR]CheckCumulativeSickDays[/COLOR]
      Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
      [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
   [COLOR=green]'====================[/COLOR]
   [COLOR=green]'has the date changed[/COLOR]
   [COLOR=green]'====================[/COLOR]
   [COLOR=darkblue]If[/COLOR] Target.Column = 8 [COLOR=darkblue]Then[/COLOR]
      lngRow = Target.Row
      dteEmpStart = Format(Target.Value, "mm/dd/yyyy")
      [COLOR=darkblue]Call[/COLOR] ProcessDateChange(lngRow, dteEmpStart)
      Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
      [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
errExit:
   Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
   [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
errHandler:
   MsgBox "Error #" & Err.Number & vbCrLf _
         & Err.Description
   [COLOR=darkblue]Resume[/COLOR] errExit
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
 
[COLOR=darkblue]Sub[/COLOR] ProcessDateChange([COLOR=darkblue]ByVal[/COLOR] myRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], _
                      [COLOR=darkblue]ByVal[/COLOR] myDate [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Date[/COLOR])
[COLOR=green]'==============================================[/COLOR]
[COLOR=green]'for a new employee clear previous row contents[/COLOR]
[COLOR=green]'==============================================[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] dteRecStart [COLOR=darkblue]As[/COLOR] Date  [COLOR=green]'records start date "N17"[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] iDateDiff [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]    [COLOR=green]'difference between empStart and RecStart dates[/COLOR]
Stop
   dteRecStart = Format(Range("N17"), "mm/dd/yyyy")
   iDateDiff = DateDiff("d", dteRecStart, myDate)
   Range(Cells(myRow, 14), Cells(myRow, 14 + iDateDiff)).ClearContents
   Range("L" & myRow).Value = 10   [COLOR=green]'reset the sickness count[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
 
[COLOR=darkblue]Sub[/COLOR] ProcessCode([COLOR=darkblue]ByVal[/COLOR] myCode [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], _
                   [COLOR=darkblue]ByVal[/COLOR] myRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR])
[COLOR=green]'=====================================[/COLOR]
[COLOR=green]'process the code entered by the user[/COLOR]
[COLOR=green]'=====================================[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] iSickCount [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
Stop
   [COLOR=darkblue]Select[/COLOR] [COLOR=darkblue]Case[/COLOR] myCode
      [COLOR=darkblue]Case[/COLOR] "D":
         [COLOR=darkblue]Call[/COLOR] msgD
      [COLOR=darkblue]Case[/COLOR] "M":
         [COLOR=darkblue]Call[/COLOR] msgM
      [COLOR=darkblue]Case[/COLOR] [COLOR=darkblue]Else[/COLOR]
         [COLOR=green]'code "S" has been entered[/COLOR]
         iSickCount = [COLOR=darkblue]CLng[/COLOR](Range("L" & myRow).Value)
         [COLOR=darkblue]If[/COLOR] iSickCount = 0 [COLOR=darkblue]Then[/COLOR]
            [COLOR=darkblue]Call[/COLOR] msgS
         [COLOR=darkblue]Else[/COLOR]
            [COLOR=green]'decrease the sickness count[/COLOR]
            iSickCount = iSickCount - 1
            Range("L" & myRow).Value = iSickCount
         [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Select[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
[COLOR=darkblue]Sub[/COLOR] msgD()
   MsgBox "You have entered the BEREAVEMENT attendance code." & vbCrLf _
   & "Please do the following:" & vbCrLf _
   & "   1. Idenify the realtionship of the deceased by inserting a comment." & vbCrLf _
   & "   2. Express your condolenses." & vbCrLf _
   & "   3. Using Tact, request documentation for their file.", vbInformation
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
[COLOR=darkblue]Sub[/COLOR] msgM()
   MsgBox "You have entered the MOVING attendance code." & vbCrLf _
   & "You need to submit a Change of Address Form to HR for this employee", vbInformation
[COLOR=darkblue]End[/COLOR] Sub
 
 
Sub msgS()
   MsgBox "Maximum sickness count reached!" & vbCrLf _
   & "Please enter a code other than 'S'. ", vbInformation
End Sub

I hope this gives you some ideas for the way to approach your problem,
Bertie
 
Upvote 0
Hi Bertie,

Thanks for your help with this. I have no experinece with VBA code, the codes that you saw in the worksheet was done by friends. The one code that you are referring to is designed to display a message box when specific data is entered. The data being the letter M and D, and also when 3 S's are entered continously, eg. The letter S is entered on Mon, Tues, Wed. Then a message box would appear, also Friday, Mon, Tues, same result. I tested the code you wrote, but it does not do any of the above. Did it work when you tested ?
 
Upvote 0
Hi Neo,

No I didn't code for counting cumulative sick days. I though that is what you were trying to do but I couldn't be certain.

I have written up a procedure called CheckCumulativeSickDays, which is called from the Worksheet_Change event.

Make a copy of your file to test the code.

I have left the Stop command in place. Press F8 to step through the code when it reaches this. This will give you a better understanding of what the code is trying to do. Test for all possible three day ranges.

You will note commented out Stop commands throughout the code. Uncomment these one at a time and thoroughly test all possible scenarios before using the code in your live file.

The amended code is:
Code: 
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Worksheet_Change([COLOR=darkblue]ByVal[/COLOR] Target [COLOR=darkblue]As[/COLOR] Range)
   [COLOR=darkblue]Dim[/COLOR] lngRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]            [COLOR=green]'target row[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] iCol [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]           'target column
   [COLOR=darkblue]Dim[/COLOR] sCode [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]           [COLOR=green]'code entered by user[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] dteEmpStart [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Date[/COLOR]       [COLOR=green]'employee start date[/COLOR]
 
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] errHandler
   Application.EnableEvents = [COLOR=darkblue]False[/COLOR] [COLOR=green]'prevent change event from re-triggering[/COLOR]
   [COLOR=darkblue]If[/COLOR] Target.Row <= 17 [COLOR=darkblue]Or[/COLOR] Target.Value = "" [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
   [COLOR=green]'Has more than one cell been changed?[/COLOR]
   [COLOR=darkblue]If[/COLOR] Target.Cells.Count > 1 [COLOR=darkblue]Then[/COLOR]
      MsgBox "Please enter codes one at a time!", vbInformation
      Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
      [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
   [COLOR=green]'========================[/COLOR]
   [COLOR=green]'has a code been entered?[/COLOR]
   [COLOR=green]'========================[/COLOR]
[COLOR=green]'Stop[/COLOR]
   [COLOR=darkblue]If[/COLOR] Target.Column >= 14 [COLOR=darkblue]Then[/COLOR]
      sCode = UCase(Target.Value)
      lngRow = Target.Row
      [COLOR=darkblue]Call[/COLOR] ProcessCode(sCode, lngRow)
      [COLOR=green]'check to see if no more sick days allowed[/COLOR]
      [COLOR=darkblue]If[/COLOR] Range("L" & lngRow).Value = 0 [COLOR=darkblue]Then[/COLOR] Target.Value = "SU"
 
      iCol = Target.Column
      [COLOR=darkblue]Call[/COLOR] [COLOR=red]CheckCumulativeSickDays[/COLOR](lngRow, iCol)
      Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
      [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
   [COLOR=green]'====================[/COLOR]
   [COLOR=green]'has the date changed[/COLOR]
   [COLOR=green]'====================[/COLOR]
[COLOR=green]'Stop[/COLOR]
   [COLOR=darkblue]If[/COLOR] Target.Column = 8 [COLOR=darkblue]Then[/COLOR]
      lngRow = Target.Row
      dteEmpStart = Format(Target.Value, "mm/dd/yyyy")
      [COLOR=darkblue]Call[/COLOR] ProcessDateChange(lngRow, dteEmpStart)
      Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
      [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
errExit:
   Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
   [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
errHandler:
   MsgBox "Error #" & Err.Number & vbCrLf _
         & Err.Description
   [COLOR=darkblue]Resume[/COLOR] errExit
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
 
[COLOR=darkblue]Sub[/COLOR] [COLOR=red]CheckCumulativeSickDays[/COLOR]([COLOR=darkblue]ByVal[/COLOR] myRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], _
                            [COLOR=darkblue]ByVal[/COLOR] myCol [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR])
   [COLOR=darkblue]Dim[/COLOR] iWeekday [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] dteSickDay [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Date[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] rngRange [COLOR=darkblue]As[/COLOR] Range
   [COLOR=darkblue]Dim[/COLOR] iCountSickDays [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
Stop
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
   dteSickDay = Cells(17, myCol).Value
   iWeekday = Application.WorksheetFunction.Weekday(dteSickDay)
 
   [COLOR=darkblue]Select[/COLOR] [COLOR=darkblue]Case[/COLOR] iWeekday
      [COLOR=darkblue]Case[/COLOR] 2, 3: [COLOR=green]'Monday or Tuesday[/COLOR]
         [COLOR=darkblue]Set[/COLOR] rngRange = Range(Cells(myRow, myCol - 4), Cells(myRow, myCol))
      [COLOR=darkblue]Case[/COLOR] 4, 5, 6: [COLOR=green]'Wednesday, Thursday or Friday[/COLOR]
         [COLOR=darkblue]Set[/COLOR] rngRange = Range(Cells(myRow, myCol - 3), Cells(myRow, myCol))
      [COLOR=darkblue]Case[/COLOR] [COLOR=darkblue]Else[/COLOR]   [COLOR=green]'Saturday or Sunday[/COLOR]
[COLOR=green]                  'what do you want to do here?[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Select[/COLOR]
 
   iCountSickDays = Application.WorksheetFunction.CountIf(rngRange, "S")
   [COLOR=darkblue]If[/COLOR] iCountSickDays = 3 Then _
      MsgBox "This employee is required to bring in a medical note." & vbCrLf _
      & "Please follow up and submit medical to HR", vbInformation
 
   [COLOR=darkblue]Set[/COLOR] rngRange = [COLOR=darkblue]Nothing[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
 
[COLOR=darkblue]Sub[/COLOR] ProcessDateChange([COLOR=darkblue]ByVal[/COLOR] myRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], _
                      [COLOR=darkblue]ByVal[/COLOR] myDate [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Date[/COLOR])
[COLOR=green]'==============================================[/COLOR]
[COLOR=green]'for a new employee clear previous row contents[/COLOR]
[COLOR=green]'==============================================[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] dteRecStart [COLOR=darkblue]As[/COLOR] Date  [COLOR=green]'records start date "N17"[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] iDateDiff [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]    [COLOR=green]'difference between empStart and RecStart dates[/COLOR]
[COLOR=green]'Stop[/COLOR]
   dteRecStart = Format(Range("N17"), "mm/dd/yyyy")
   iDateDiff = DateDiff("d", dteRecStart, myDate)
   Range(Cells(myRow, 14), Cells(myRow, 14 + iDateDiff)).ClearContents
   Range("L" & myRow).Value = 10   [COLOR=green]'reset the sickness count[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
 
 
[COLOR=darkblue]Sub[/COLOR] ProcessCode([COLOR=darkblue]ByVal[/COLOR] myCode [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], _
                   [COLOR=darkblue]ByVal[/COLOR] myRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR])
[COLOR=green]'=====================================[/COLOR]
[COLOR=green]'process the code entered by the user[/COLOR]
[COLOR=green]'=====================================[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] iSickCount [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
[COLOR=green]'Stop[/COLOR]
   [COLOR=darkblue]Select[/COLOR] [COLOR=darkblue]Case[/COLOR] myCode
      [COLOR=darkblue]Case[/COLOR] "D":
         [COLOR=darkblue]Call[/COLOR] msgD
      [COLOR=darkblue]Case[/COLOR] "M":
         [COLOR=darkblue]Call[/COLOR] msgM
      [COLOR=darkblue]Case[/COLOR] [COLOR=darkblue]Else[/COLOR]
         [COLOR=green]'code "S" has been entered[/COLOR]
         iSickCount = [COLOR=darkblue]CLng[/COLOR](Range("L" & myRow).Value)
         [COLOR=darkblue]If[/COLOR] iSickCount = 0 [COLOR=darkblue]Then[/COLOR]
            [COLOR=darkblue]Call[/COLOR] msgS
         [COLOR=darkblue]Else[/COLOR]
            [COLOR=green]'decrease the sickness count[/COLOR]
            iSickCount = iSickCount - 1
            Range("L" & myRow).Value = iSickCount
         [COLOR=darkblue]End[/COLOR] If
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Select[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
 
[COLOR=darkblue]Sub[/COLOR] msgD()
   MsgBox "You have entered the BEREAVEMENT attendance code." & vbCrLf _
   & "Please do the following:" & vbCrLf _
   & "   1. Idenify the realtionship of the deceased by inserting a comment." & vbCrLf _
   & "   2. Express your condolenses." & vbCrLf _
   & "   3. Using Tact, request documentation for their file.", vbInformation
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
Sub msgM()
   MsgBox "You have entered the MOVING attendance code." & vbCrLf _
   & "You need to submit a Change of Address Form to HR for this employee", vbInformation
[COLOR=darkblue]End[/COLOR] Sub
 
 
Sub msgS()
   MsgBox "Maximum sickness count reached!" & vbCrLf _
   & "Please enter a code other than 'S'. ", vbInformation
End Sub
 
Upvote 0
Hi Bertie,

I tested the code, their still seems to be a few problems.

I need the message box for the 3 day scenerio to appear not only after 3 S's but again after the fourth, fifth, sixth etc....

Also noticed that although the number in Column L was set at 10, I was only able to enter 9 S's. When I entered the 10th S the message box appeared, this needs to appear after the user tries to enter S the 11th time.

Also have to account for errors, eg. some one enters S by mistake, this will reduce the number by 1, if that S is removed then the number should go back up by one.

The message box does not appear when the letters M and D are entered.

This is how I envision this working. At the beginning of the year column L will be filled in with a range of numbers ranging from 0 to a maximum value of 10, at this point whenever an S is entered 1 must be subtracted from the total in column L, if this total is 10 then it would then be 9, if the total is already zero, then the message box would appear at this point, prompting the user to enter SU. The message box only appears when the total in column L is at zero and the user attempts to enter S.
The employee gets back his sick days on his anniversary date, eg. the hire date for someone is 1-20-90, the number in column L has to automatically be reset to 10 on this date, 1-20-2011, so if the number in Column L was 2, then it would go back to 10. When this happens the cycle outlined above will repeat itself.

Would it be easier to build a separate code for this rather than combining it with the other ?
 
Upvote 0
Hi Neo,

Copy and run this code first to reset application events.
Code: 
[COLOR=darkblue]Sub[/COLOR] Reset()
   Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
I need the message box for the 3 day scenerio to appear not only after 3 S's but again after the fourth, fifth, sixth etc....
Click to expand...
I have changed from "=3" to ">=3"

Also noticed that although the number in Column L was set at 10, I was only able to enter 9 S's. When I entered the 10th S the message box appeared, this needs to appear after the user tries to enter S the 11th time.
Click to expand...

I moved this line to before Call PrcessCode rather than after.
Code: 
      [COLOR=green]'check to see if no more sick days allowed[/COLOR]
     [COLOR=red]If Range("L" & lngRow).Value = 0 Then Target.Value = "SU"[/COLOR]
      [COLOR=darkblue]Call[/COLOR] ProcessCode(sCode, lngRow)

Also have to account for errors, eg. some one enters S by mistake, this will reduce the number by 1, if that S is removed then the number should go back up by one.
Click to expand...
The problem with this one is there is no way of knowing if the entry removed was an "S", "M" or "D". So I have included a prompt for the user to decide if they want to reset the Sick Bank count.
Code: 
      [COLOR=green]'reset Sick Bank if entry deleted[/COLOR]
      [COLOR=darkblue]If[/COLOR] IsEmpty(Target.Value) [COLOR=darkblue]Then[/COLOR]
         answer = MsgBox("Do you want to reset Sick Bank?", vbYesNo)
         [COLOR=darkblue]If[/COLOR] answer = vbYes [COLOR=darkblue]Then[/COLOR]
            SickCount = Range("L" & lngRow).Value
            Range("L" & lngRow).Value = SickCount + 1
         [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
         [COLOR=darkblue]GoTo[/COLOR] errExit   [COLOR=#008000]'reset Application.EnableEvents to true before exit[/COLOR]
      [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]

The message box does not appear when the letters M and D are entered.
Click to expand...
If you use F8, step through for debugging make sure you reset Application.EnableEvents to True before exiting. Easiest way is to press F5 to finish running the code.

As before Make a copy of your workbook.

I have included the reset code. If the code stops working all of a sudden run this and try again.

The amended code is:
Code: 
[COLOR=red]Sub Reset()[/COLOR]
[COLOR=red]Application.EnableEvents = True[/COLOR]
[COLOR=red]End Sub[/COLOR]
 
 
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Worksheet_Change([COLOR=darkblue]ByVal[/COLOR] Target [COLOR=darkblue]As[/COLOR] Range)
   [COLOR=darkblue]Dim[/COLOR] lngRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]            [COLOR=green]'target row[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] iCol [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]           'target column
   [COLOR=darkblue]Dim[/COLOR] sCode [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]           [COLOR=green]'code entered by user[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] dteEmpStart [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Date[/COLOR]       [COLOR=green]'employee start date[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] answer [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]         [COLOR=green]'Yes/No[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] SickCount [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
 
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] errHandler
   Application.EnableEvents = [COLOR=darkblue]False[/COLOR] [COLOR=green]'prevent change event from re-triggering[/COLOR]
 
   [COLOR=darkblue]If[/COLOR] Target.Row <= 17 [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
   [COLOR=green]'Has more than one cell been changed?[/COLOR]
   [COLOR=darkblue]If[/COLOR] Target.Cells.Count > 1 [COLOR=darkblue]Then[/COLOR]
      MsgBox "Please enter codes one at a time!", vbInformation
      [COLOR=darkblue]GoTo[/COLOR] errExit
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
   lngRow = Target.Row
   iCol = Target.Column
   [COLOR=darkblue]If[/COLOR] Target.Column >= 14 [COLOR=darkblue]Then[/COLOR]
      [COLOR=green]'reset Sick Bank if entry deleted[/COLOR]
[COLOR=red]   If IsEmpty(Target.Value) Then[/COLOR]
[COLOR=red]      answer = MsgBox("Do you want to reset Sick Bank?", vbYesNo)[/COLOR]
[COLOR=red]      If answer = vbYes Then[/COLOR]
[COLOR=red]         SickCount = Range("L" & lngRow).Value[/COLOR]
[COLOR=red]         Range("L" & lngRow).Value = SickCount + 1[/COLOR]
[COLOR=red]      End If[/COLOR]
         [COLOR=darkblue]GoTo[/COLOR] errExit
      [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
      [COLOR=green]'has a code been entered?[/COLOR]
      sCode = UCase(Target.Value)
      [COLOR=green]'check to see if no more sick days allowed[/COLOR]
      [COLOR=red]If Range("L" & lngRow).Value = 0 Then Target.Value = "SU"[/COLOR]
 
      [COLOR=darkblue]Call[/COLOR] ProcessCode(sCode, lngRow)
      [COLOR=darkblue]Call[/COLOR] CheckCumulativeSickDays(lngRow, iCol)
      [COLOR=darkblue]GoTo[/COLOR] errExit
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
   [COLOR=green]'has the date changed[/COLOR]
   [COLOR=darkblue]If[/COLOR] Target.Column = 8 [COLOR=darkblue]Then[/COLOR]
      dteEmpStart = Format(Target.Value, "mm/dd/yyyy")
      [COLOR=darkblue]Call[/COLOR] ProcessDateChange(lngRow, dteEmpStart)
      Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
      [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
errExit:
   Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
   [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
errHandler:
   MsgBox "Error #" & Err.Number & vbCrLf _
         & Err.Description
   [COLOR=darkblue]Resume[/COLOR] errExit
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
 
[COLOR=darkblue]Sub[/COLOR] CheckCumulativeSickDays([COLOR=darkblue]ByVal[/COLOR] myRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], _
                            [COLOR=darkblue]ByVal[/COLOR] myCol [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR])
   [COLOR=darkblue]Dim[/COLOR] iWeekday [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] dteSickDay [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Date[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] rngRange [COLOR=darkblue]As[/COLOR] Range
   [COLOR=darkblue]Dim[/COLOR] iCountSickDays [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
[COLOR=green]'Stop[/COLOR]
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
   dteSickDay = Cells(17, myCol).Value
   iWeekday = Application.WorksheetFunction.Weekday(dteSickDay)
 
   [COLOR=darkblue]Select[/COLOR] [COLOR=darkblue]Case[/COLOR] iWeekday
      [COLOR=darkblue]Case[/COLOR] 2, 3: [COLOR=green]'Monday or Tuesday[/COLOR]
         [COLOR=darkblue]Set[/COLOR] rngRange = Range(Cells(myRow, myCol - 4), Cells(myRow, myCol))
      [COLOR=darkblue]Case[/COLOR] 4, 5, 6: [COLOR=green]'Wednesday, Thursday or Friday[/COLOR]
         [COLOR=darkblue]Set[/COLOR] rngRange = Range(Cells(myRow, myCol - 3), Cells(myRow, myCol))
      [COLOR=darkblue]Case[/COLOR] [COLOR=darkblue]Else[/COLOR]   [COLOR=green]'Saturday or Sunday[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Select[/COLOR]
 
   iCountSickDays = Application.WorksheetFunction.CountIf(rngRange, "S")
   [COLOR=darkblue]If[/COLOR] [COLOR=red]iCountSickDays >=[/COLOR][COLOR=red] 3[/COLOR] Then _
      MsgBox "This employee is required to bring in a medical note." & vbCrLf _
      & "Please follow up and submit medical to HR", vbInformation
 
   [COLOR=darkblue]Set[/COLOR] rngRange = [COLOR=darkblue]Nothing[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
 
[COLOR=darkblue]Sub[/COLOR] ProcessDateChange([COLOR=darkblue]ByVal[/COLOR] myRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], _
                      [COLOR=darkblue]ByVal[/COLOR] myDate [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Date[/COLOR])
[COLOR=green]'==============================================[/COLOR]
[COLOR=green]'for a new employee clear previous row contents[/COLOR]
[COLOR=green]'==============================================[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] dteRecStart [COLOR=darkblue]As[/COLOR] Date  [COLOR=green]'records start date "N17"[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] iDateDiff [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]    [COLOR=green]'difference between empStart and RecStart dates[/COLOR]
[COLOR=green]'Stop[/COLOR]
   dteRecStart = Format(Range("N17"), "mm/dd/yyyy")
   iDateDiff = DateDiff("d", dteRecStart, myDate)
   Range(Cells(myRow, 14), Cells(myRow, 14 + iDateDiff)).ClearContents
   Range("L" & myRow).Value = 10   [COLOR=green]'reset the sickness count[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
 
[COLOR=darkblue]Sub[/COLOR] ProcessCode([COLOR=darkblue]ByVal[/COLOR] myCode [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], _
                   [COLOR=darkblue]ByVal[/COLOR] myRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR])
[COLOR=green]'=====================================[/COLOR]
[COLOR=green]'process the code entered by the user[/COLOR]
[COLOR=green]'=====================================[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] iSickCount [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
[COLOR=green]'Stop[/COLOR]
   [COLOR=darkblue]Select[/COLOR] [COLOR=darkblue]Case[/COLOR] myCode
      [COLOR=darkblue]Case[/COLOR] "D":
         [COLOR=darkblue]Call[/COLOR] msgD
      [COLOR=darkblue]Case[/COLOR] "M":
         [COLOR=darkblue]Call[/COLOR] msgM
      [COLOR=darkblue]Case[/COLOR] [COLOR=darkblue]Else[/COLOR]
         [COLOR=green]'code "S" has been entered[/COLOR]
         iSickCount = [COLOR=darkblue]CLng[/COLOR](Range("L" & myRow).Value)
         [COLOR=darkblue]If[/COLOR] iSickCount = 0 [COLOR=darkblue]Then[/COLOR]
            [COLOR=darkblue]Call[/COLOR] msgS
         [COLOR=darkblue]Else[/COLOR]
            [COLOR=green]'decrease the sickness count[/COLOR]
            iSickCount = iSickCount - 1
            Range("L" & myRow).Value = iSickCount
         [COLOR=darkblue]End[/COLOR] If
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Select[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
 
[COLOR=darkblue]Sub[/COLOR] msgD()
   MsgBox "You have entered the BEREAVEMENT attendance code." & vbCrLf _
   & "Please do the following:" & vbCrLf _
   & "   1. Idenify the realtionship of the deceased by inserting a comment." & vbCrLf _
   & "   2. Express your condolenses." & vbCrLf _
   & "   3. Using Tact, request documentation for their file.", vbInformation
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
 
Sub msgM()
   MsgBox "You have entered the MOVING attendance code." & vbCrLf _
   & "You need to submit a Change of Address Form to HR for this employee", vbInformation
[COLOR=darkblue]End[/COLOR] Sub
 
 
Sub msgS()
   MsgBox "Maximum sickness count reached!" & vbCrLf _
   & "Please enter a code other than 'S'. ", vbInformation
End Sub
 
Upvote 0
Hi Bertie,

I noticed when the bank goes to zero, the only code I'm allowed to enter is SU, this has to be changed, I believed I miscommunicated this part.

When the bank is zero, and the user enters S, then message box appears saying no more paid sick days allowed, the user must then be able to enter any other code. The only code not allowed at this point is S. Sorry about that.

Is there a way to get around resetting the sick bank count. The reason I don't like this option is because if the user accidently clicks no instead of yes to resetting the count then the data will be incorrect. I am pretty sure that will happen.
 
Upvote 0
Hi Neo,

For the first part is straightforward enough. Change this line:
Code: 
[COLOR=black]      [COLOR=seagreen]'check to see if no more sick days allowed[/COLOR]
      [/COLOR][COLOR=red]If Range("L" & lngRow).Value = 0 Then Target.Value = "SU"[/COLOR]

To something like:
Code: 
      [COLOR=green]'check to see if no more sick days allowed[/COLOR]
[COLOR=black]      If Range("L" & lngRow).Value = 0 and Target.Value = "S" then[/COLOR]
[COLOR=black]         target=""[/COLOR]
[COLOR=black]        msgbox "No more S'ssss"[/COLOR]
[COLOR=black]     end if[/COLOR]

The second point you raised is not so straightforward. If there was a 100% guarantee the user would only delete an "S" code it would be a simple addition. But what if the user deletes an "M" or "D" code?

When the change event triggers and the code runs the value has already been removed. I can think of no way of knowing what the user has deleted.

I presume for such an important file you have a back up. I am also presuming that the file won't be available to a large group of people. You may want to explore creating a user form for interaction with the file. That way you could write a log of all changes made and undo them if necessary.

Bertie
 
Upvote 0
Hi Bertie,

I altered the code as you suggested. The problem now is that the S is not restricted, the message box appears but it does not restrict the actual S. Need to restrict S at this point but allow everything else.

You presume correctly. I'm not quite sure what you mean exactly by user form.
 
Upvote 0
Hi Neo,

The code won't restrict an "S" being entered. The code is a Worksheet_Change event, it is reacting to (running after) changes have been made.

The only way I can think of for preventing a particular character from being entered into a cell is running a program to monitor Key Strokes. But these events are only available to user forms, i.e., KeyDown, KeyPress.

What I mean by a user form is to use your spreadsheet as a database and have a form at the front end as the only means of accessing the data.
 
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Question
Help Needed for a Macro to Transpose
Replies
6
Views
135
alansidman
A
A
  • Question
Annual Bonus Prorated
Replies
1
Views
477
t0ny84
T
J
  • Locked
  • Question
Still need help on a daily summary sheet
Replies
1
Views
282
Fluff
Fluff
P
  • Solved
VBA Help - Runtime error -2147417848 (80010108) - Method has failed
Replies
8
Views
303
PTSD
P
R
  • Question
Distribution of Fund
Replies
1
Views
318
RAMU
R

Forum statistics

Threads
1,214,593
Messages
6,120,435
Members
448,961
Latest member
nzskater

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top