need help to build macro

Some videos you may like

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

bertie

Well-known Member
Joined
Jun 12, 2009
Messages
1,869
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
 

neo2

New Member
Joined
Jul 22, 2010
Messages
33
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 ?
 

bertie

Well-known Member
Joined
Jun 12, 2009
Messages
1,869
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
 

neo2

New Member
Joined
Jul 22, 2010
Messages
33

ADVERTISEMENT

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 ?
 

bertie

Well-known Member
Joined
Jun 12, 2009
Messages
1,869
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....
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.
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.
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.
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
 

neo2

New Member
Joined
Jul 22, 2010
Messages
33

ADVERTISEMENT

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.
 

bertie

Well-known Member
Joined
Jun 12, 2009
Messages
1,869
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
 

neo2

New Member
Joined
Jul 22, 2010
Messages
33
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.
 

bertie

Well-known Member
Joined
Jun 12, 2009
Messages
1,869
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.
 

Subscribe on YouTube

Watch MrExcel Video

Forum statistics

Threads
1,106,597
Messages
5,512,313
Members
408,886
Latest member
kashifziatevta423

This Week's Hot Topics

  • Sort code advice please
    Hi, I have the code below which im trying to edit but getting a little stuck. This was the original code which worked fine,columns A-F would sort...
  • SUMPRODUCT with nested If statement
    Hi everyone, Hope you're all well. I'm hoping someone will be able to point me in the right direction with a problem I'm having with a SUMPRODUCT...
  • VBA - simple sort is killing me!
    Hello all! This should be so easy, but not for me, apparently! I have a table of data that can be of varying lengths and widths. My current macro...
  • Compare Two Lists
    I have two Lists and I need to be able to Identify differences between them. List 100 comes from a workbook - the other is downloaded form the...
  • Formula that deducts points for each code I input.
    I am trying to create a formula that will have each student in my class start at 100 points and then for each code that I enter (PP for Poor...
  • Conditional formatting formula required for day of week and a value
    Hi, I have a really simple spreadsheet where column A is the date, column B is the activity total shown as a number and column C states the day of...
Top