Could assist on this?
For Example, column A is date today which will fill in automatically, if the person fill in due date at column B.
However, if the due date is more than 3 months of the date today, it will restrict the person to fill in the due date. The person only can fill in the due date if the due date is equal or less than 3 months as per date today.
Could help me check if how to edit the VBA code:
[enter image description here]
I'm not certain if you meant 3 months after today or before today, but if you have =IF(ISBLANK(#B:B),"",TODAY()) as the formula in column A, insert this into the worksheet object code.
Option Explicit
#Const ShowErrMsg = True 'Change to False if you want the invalid insertion to fail silently and not send the user an error message.
Private Sub Worksheet_Change(ByVal Target As Range)
Const InvalidDateErrorNumber = 1234 + vbObjectError 'Always add vbObjectError to custom error numbers inside a class
Dim cel As Excel.Range, ChangedDueDateRange As Excel.Range
Dim ErrMsg As String
On Error GoTo EH_InvalidDueDate
Set ChangedDueDateRange = Excel.Intersect(Target, Me.Range("B:B")) 'You might change a large range of cells, but we're only concerned with those in Column B
If Not ChangedDueDateRange Is Nothing Then
For Each cel In ChangedDueDateRange
CellCleared: 'Return here after clearing the cell.
If Not cel.Value = vbEmpty Then
If CDate(cel.Value) > VBA.DateTime.DateAdd("m", 3, VBA.Date) Then 'CDate in case you end up pasting a number that could be equivalent to a date.
Err.Raise InvalidDateErrorNumber, Source:=Me.Name, Description:="Invalid Date"
#If ShowErrMsg Then 'This sort of #if is a compiler directive that basically toggles code on and off without evaluating a condition at runtime.
VBA.Interaction.MsgBox ErrMsg, Buttons:=VbMsgBoxStyle.vbExclamation, Title:="Invalid Date"
#End If
End If
End If
Next cel
End If
Exit Sub
EH_InvalidDueDate:
ErrMsg = cel.Address(RowAbsolute:=False, Columnabsolute:=False)
Select Case Err.Number
Case 13 '13 is type mismatch, in case the value inserted is not even a date.
ErrMsg = "Insert a date up to 3 months after today into cell " & ErrMsg & vbNewLine & ". You entered a " & TypeName(cel.Value)
Case InvalidDateErrorNumber
ErrMsg = "Date inserted in cell " & ErrMsg & " is more than 3 months after today."
Case Else
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Select
With Application 'Temporarily disable events to avoid triggering an infinite loop of change events.
.EnableEvents = False
cel.ClearContents
.EnableEvents = True
End With
Resume CellCleared
End Sub
Related
At work we are using Office 365 Excel's file as a booking system. It has multiple tabs for each site where each record has a booking date. There is problem of date formatting - basically the default locale is set to "mm/dd/yyyy" however the date is displayed in "dd/mm/yyyy". When people add rows manually (normally booking slots are generated automatically for each day) and just type in date in a wrong format instead of copying date value from the adjacent cell it displays right, but the cell value in the top bar is different, but when opening this file in the Desktop App it does not see this as different values at all. Only when applying filter, there are dates, and string date values you can filter by. This causes some of the dates not being picked up by the macros while creating reports, or importing data based on the date.
I've been thinking of writing an utility macro that would sanitize all dates based on the dates up and down to the current date, however I am not sure if this is the best way to go. I don't think I can just change the locale settings for all users as for what I read in docs this will make changes only to the single user settings and I am not really sure how this will affect overall functionality of whole system. Is there any way it can be done rather more easily than parsing this massive file or manually finding this dates?
It is a real pain as this file was designed long time before I came to the team and now I am trying to make this less error prone.
Thanks for any clues in advance!
Real dates are numeric. So you can check with IsNumeric
If IsNumeric(Range("A1").Value2) Then
Debug.Print "date"
Else
Debug.Print "string"
End If
Note that you need to check .Value2 not .Value
Peh's answer guided me to the right solution. Here is the whole code if anyone would came across similar problem:
Sub SanitizeDates()
' ---
' Utility macro that goes over all live sheets and checks all rows
' for the string dates that have been input manually
' and converts it to an actual Date values.
' ---
Debug.Print "--- Log Start"
Dim Prompt As String
Dim Errors As Integer
Dim TotalErrors As Integer
TotalErrors = 0
Errors = 0
Dim Tracker As Workbook
Dim WS As Worksheet
Dim CurrentDateValue As Variant
Dim NewDate As Date
Dim RowCount As Long
Dim nRow As Long
Set Tracker = ThisWorkbook
Application.ScreenUpdating = False
For Each WS In Tracker.Worksheets
If WS.Visible And Not WS.Name = "Matrix" Then ' if worksheet is not visible and not a Matrix
If InStr(1, WS.Name, "Template", vbTextCompare) = 0 Then ' if worksheet is not a template
Errors = 0
RowCount = WS.ListObjects(1).DataBodyRange.Rows.Count
'loop over all rows in table
For nRow = 1 To RowCount
With WS.ListObjects(1).DataBodyRange
' check if the cell is a black bar / divider
If Not .Cells(nRow, 3).Interior.Color = RGB(0, 0, 0) Then
If Not IsNumeric(.Cells(nRow, 3).Value2) Then
On Error GoTo SkipInvalid
NewDate = DateValue(.Cells(nRow, 3).Value2)
.Cells(nRow, 3).Value2 = NewDate
Errors = Errors + 1
'Error logging
'Call LogError(.Cells(nRow, 5), .Cells(nRow, 15), "Date Format - dev")
End If
End If
End With
SkipInvalid:
Next nRow
TotalErrors = TotalErrors + Errors
If Errors Then
Prompt = Prompt & "Found " & Errors & " errors in " & WS.Name & vbCrLf
Debug.Print "Found " & Errors & " errors in " & WS.Name
End If
End If
End If
Next WS
Application.ScreenUpdating = True
Debug.Print "--- Log End"
If TotalErrors Then
MsgBox (Prompt & vbCrLf & vbCrLf & _
"Total of " & TotalErrors & " errors found. All data sanitized successfully.")
Else
MsgBox ("No errors found")
End If
End Sub
Looks like your problem derives from the fact people are entering invalid dates.
You may try to apply a data validation on the cells to sanitize during data entry.
Data validation allows to set a cell as Date and then you can specify a date range. So only valid dates within that range will be allowed.
I'm working on a simple Excel file with some worksheets where in every one I've report hours and minutes of work. I want to show it like 313:32 that is 313 hours and 32 minutes, to do that I'm using a custom format [h]:mm
To facilitate the workers that use Excel very little, I have thought to create some vba code, so that they could insert also not only the minutes, besides the classical format [h]:mm, so they can also insert value in hours and minutes.
I report some example data that I want to have.
What I insert -> what I want that are printed inside the cell
1 -> 0:01
2 -> 0:02
3 -> 0:03
65 -> 1:05
23:33 -> 23:33
24:00 -> 24:00
24:01 -> 24:01
Then I formatted every cell that can contain a time value in [h]:mm and I wrote this code
Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo bm_Safe_Exit
With Sh
If IsNumeric(Target) = True And Target.NumberFormat = "[h]:mm" Then
If Int(Target.Value) / Target.Value = 1 Then
Debug.Print "Integer -> " & Target.Value
Application.EnableEvents = False
Target.Value = Target.Value / 1440
Application.EnableEvents = True
Exit Sub
End If
Debug.Print "Other value -> " & Target.Value
End If
End With
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
The code works well enough, but it errs when I enter 24:00 and its multiples, 48:00, 72:00 ...
This because the cell are formatted [h]:mm so 24:00 became 1 before the vba code execution!
I tried to correct the code, and the funny fact is that when I correct the 24:00, so 24:00 remain 24:00 and not 00:24, the problem switch to 1 that became 24:00 instead 00:01
My first idea was to "force" the vba code execution before the cell format, but I don't know if it is possible.
I know that seems a stupid question, but I really don't know if it is possible and how to fix it.
Any idea will be much appreciated
Requirements: Time is to be reported in Hours and Minutes, minutes is the lowest measure ( i.e.: whatever the amount of time is to be reported in hours and the partial hours in minutes, i.e. 13 days, 1 hour and 32 minutes or 13.0638888888888889 shall be shown as 313:32 )
Users should be allowed to enter time in two different manners:
To enter only minutes: The value entered shall be a whole number (no decimals).
To enter hours and minutes: The value entered shall be composed by two whole numbers representing the hours and the minutes separated a colon :.
Excel Processing Values Entered:
Excel intuitively process the Data type and Number.Format of the values entered in cells.
When the Cell NumberFormat is General, Excel converts the values entered to the data type in relation with the data entered (String, Double, Currency, Date, etc. ), it also changes the NumberFormat as per the “format” entered with the value (see table below).
When the Cell NumberFormat is other than General, Excel converts the values entered to the data type corresponding to the format of the cell, with no changes to the NumberFormat (see table below).
Therefore, it's not possible to know the format of the values as entered by the user, unless the values entered can be can intercepted before Excel applies its processing methods.
Although the values entered cannot be intercepted before Excel process them, we can set a validation criteria for the values entered by the users using the Range.Validation property.
Solution: This proposed solution uses:
Workbook.Styles property (Excel): To identify and format the Input cells.
Range.Validation property (Excel): To communicate the users the format required for the values entered, enforcing them to enter the data as text.
Workbook_SheetChange workbook event: To validate and process the values entered.
It's suggested to use a customized style to identify and format the input cells, actually OP is using the NumberFormat to identify the input cells, however it seems that there could also be cells with formulas, or objects (i.e. Summary Tables, PivotTables, etc.) that require the same NumberFormat. By using the customized style only for the input cells, the non-input cells can be easily excluded from the process.
The Style object (Excel) allows to set the NumberFormat, Font, Alignment, Borders, Interior and Protection at once for a single or multiple cells. The procedure below adds a customized Style named TimeInput. The name of the Style is defined as a public constant because it will be used across the workbook.
Add this into an standard module
Public Const pk_StyTmInp As String = "TimeInput"
Private Sub Wbk_Styles_Add_TimeInput()
With ActiveWorkbook.Styles.Add(pk_StyTmInp)
.IncludeNumber = True
.IncludeFont = True
.IncludeAlignment = True
.IncludeBorder = True
.IncludePatterns = True
.IncludeProtection = True
.NumberFormat = "[h]:mm"
.Font.Color = XlRgbColor.rgbBlue
.HorizontalAlignment = xlGeneral
.Borders.LineStyle = xlNone
.Interior.Color = XlRgbColor.rgbPowderBlue
.Locked = False
.FormulaHidden = False
End With
End Sub
The new Style will show in the Home tab, just select the input range and apply the Style.
We’ll use the Validation object (Excel) to tell users the criteria for the time values and to force them to enter the values as Text.
The following procedure sets the style of the Input range and adds a validation to each cell:
Private Sub InputRange_Set_Properties(Rng As Range)
Const kFml As String = "=ISTEXT(#CLL)"
Const kTtl As String = "Time as ['M] or ['H:M]"
Const kMsg As String = "Enter time preceded by a apostrophe [']" & vbLf & _
"enter M minutes as 'M" & vbLf & _
"or H hours and M minutes as 'H:M" 'Change as required
Dim sFml As String
Application.EnableEvents = False
With Rng
.Style = pk_StyTmInp
sFml = Replace(kFml, "#CLL", .Cells(1).Address(0, 0))
With .Validation
.Delete
.Add Type:=xlValidateCustom, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=sFml
.IgnoreBlank = True
.InCellDropdown = False
.InputTitle = kTtl
.InputMessage = kMsg
.ShowInput = True
.ErrorTitle = kTtl
.ErrorMessage = kMsg
.ShowError = True
End With: End With
Application.EnableEvents = True
End Sub
The procedure can be called like this
Private Sub InputRange_Set_Properties_TEST()
Dim Rng As Range
Set Rng = ThisWorkbook.Sheets("TEST").Range("D3:D31")
Call InputRange_Set_Properties(Rng)
End Sub
Now that we have set the input range with the appropriated style and validation, let’s write the Workbook Event that will process the Time inputs:
Copy these procedures in ThisWorkbook module:
Workbook_SheetChange - Workbook event
InputTime_ƒAsDate - Support function
InputTime_ƒAsMinutes - Support function
…
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Const kMsg As String = "[ #INP ] is not a valid entry."
Dim blValid As Boolean
Dim vInput As Variant, dOutput As Date
Dim iTime As Integer
Application.EnableEvents = False
With Target
Rem Validate Input Cell
If .Cells.Count > 1 Then GoTo EXIT_Pcdr 'Target has multiple cells
If .Style <> pk_StyTmInp Then GoTo EXIT_Pcdr 'Target Style is not TimeInput
If .Value = vbNullString Then GoTo EXIT_Pcdr 'Target is empty
Rem Validate & Process Input Value
vInput = .Value 'Set Input Value
Select Case True
Case Application.IsNumber(vInput): GoTo EXIT_Pcdr 'NO ACTION NEEDED - Cell value is not a text thus is not an user input
Case InStr(vInput, ":") > 0: blValid = InputTime_ƒAsDate(dOutput, vInput) 'Validate & Format as Date
Case Else: blValid = InputTime_ƒAsMinutes(dOutput, vInput) 'Validate & Format as Minutes
End Select
Rem Enter Output
If blValid Then
Rem Validation was OK
.Value = dOutput
Else
Rem Validation failed
MsgBox Replace(kMsg, "#INP", vInput), vbInformation, "Input Time"
.Value = vbNullString
GoTo EXIT_Pcdr
End If
End With
EXIT_Pcdr:
Application.EnableEvents = True
End Sub
…
Private Function InputTime_ƒAsDate(dOutput As Date, vInput As Variant) As Boolean
Dim vTime As Variant, dTime As Date
Rem Output Initialize
dOutput = 0
Rem Validate & Process Input Value as Date
vTime = Split(vInput, ":")
Select Case UBound(vTime)
Case 1
On Error Resume Next
dTime = TimeSerial(CInt(vTime(0)), CInt(vTime(1)), 0) 'Convert Input to Date
On Error GoTo 0
If dTime = 0 Then Exit Function 'Input is Invalid
dOutput = dTime 'Input is Ok
Case Else: Exit Function 'Input is Invalid
End Select
InputTime_ƒAsDate = True
End Function
…
Private Function InputTime_ƒAsMinutes(dOutput As Date, vInput As Variant) As Boolean
Dim iTime As Integer, dTime As Date
Rem Output Initialize
dOutput = 0
Rem Validate & Process Input Value as Integer
On Error Resume Next
iTime = vInput
On Error GoTo 0
Select Case iTime = vInput
Case True
On Error Resume Next
dTime = TimeSerial(0, vInput, 0) 'Convert Input to Date
On Error GoTo 0
If dTime = 0 Then Exit Function 'Input is Invalid
dOutput = dTime 'Input is Ok
Case Else: Exit Function 'Input is Invalid
End Select
InputTime_ƒAsMinutes = True
End Function
The table below shows the output for various types of values entered.
The simplest way appears to be to use the cell text (i.e. how the cell is displayed) in preference to the actual cell value. If it looks like a time (e.g. "[h]:mm", "hh:mm", "hh:mm:ss") then use that to add the value of each time part accordingly (to avoid the 24:00 issue). Otherwise, if it's a number, assume that to be minutes.
The below method also works for formats like General, Text and Time (unless the time begins with a days part, but it could be further developed to deal with that too where necessary).
Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo bm_Safe_Exit
Dim part As String, parts() As String, total As Single
Application.EnableEvents = False
If Not IsEmpty(Target) And Target.NumberFormat = "[h]:mm" Then
'prefer how the Target looks over its underlying value
If InStr(Target.Text, ":") Then
'split by ":" then add the parts to give the decimal value
parts = Split(Target.Text, ":")
total = 0
'hours
If IsNumeric(parts(0)) Then
total = CInt(parts(0)) / 24
End If
'minutes
If 0 < UBound(parts) Then
If IsNumeric(parts(1)) Then
total = total + CInt(parts(1)) / 1440
End If
End If
ElseIf IsNumeric(Target.Value) Then
'if it doesn't look like a time format but is numeric, count as minutes
total = Target.Value / 1440
End If
Target.Value = total
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
If a specific value will entered in row "A", a specific price should be inserted into row "D" and after that the entered price should be displayed in a messagebox.
The first part was just an easy setup, but with the msgbox I have actually some issues.
Maybe because of the procedure of the code?! The price is just in this moment inside the cell and my code is already trying to get this in the moment empty cell?! - not sure.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Handler
Dim price As String
If Target.Column = 1 And Target.Value = "XY01" Then
Application.EnableEvents = False
Target.Offset(0, 3) = Format(0.7, "currency")
Application.EnableEvents = True
price = ActiveCell.Offset(0, 3).Value
MsgBox "The price is now " & price
End If
Handler:
End Sub
The really strange thing is that inside the first row it will be displayed as excepted:
Just in every other row it will be displayed like this (it's just empty):
My 2nd question is that I have formatted the value as "currency", but I'm anyway get this error message (in English like that the cell is formatted as text). Also by formatting the cell by the excel tools the error message will not disappear.
Any Idea to fix this?
Thank you guys.
==============
EDIT
I have updated my code to following, so I was able to solve my 2nd question regarding the note that my value is just a text.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Handler
Dim price As String
If Target.Column = 1 And Target.Value = "XY01" Then
Application.EnableEvents = False
Target.Offset(0, 3).Value = 0.7
Target.Offset(0, 3).NumberFormat = "currency"
Application.EnableEvents = True
price = Target.Offset(0, 3).Text
MsgBox "The price is now " & price
End If
Handler:
End Sub
I don't know why, but now will not be any msgbox displayed?!
Also the price will now only once inserted, if I type in the code again in another cell (a cell down) the code seems not be running again?!
I need to reopen excel to bring it up to work again.
The Format function always returns a string/text.
So here: Target.Offset(0, 3) = Format(0.7, "currency") you don't write a numeric value but a text.
Instead write the value and set the number format of the cell:
Target.Offset(0, 3).Value = 0.7
Target.Offset(0, 3).NumberFormat = "#,##0.00 $"
Then you can read the cell's .Text (instead of .Value) to get it formatted as shown in cell:
Dim price As Sting
price = Target.Offset(0, 3).Text
MsgBox "The price is now " & price
or read the cell's Value and format it whatever you like:
Dim price As Double
price = Target.Offset(0, 3).Value
MsgBox "The price is now " & Format(price, "#,##0.00 $")
Can you try to change this line:
Dim price As Double
Good Luck
how can I make the double click works ONLY when column 1,2,3 and 4 have values? I don't know where I should insert the code.. it's something like if column 1,2,3 and 4 have values then doubleclick.enable = TRUE else doubleclick.enable= FALSE..
Kindly need advice. My code is as follows:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Select Case Target.Column
Case 6, 13
If Not Intersect(Target, Range("F2:F13, M2:M13")) Is Nothing Then Cancel = True
Target.Font.Name = "Times New Roman"
If Target = "" Then
Target = ChrW(&H2713)
Else
MsgBox "You cannot modify the cell."
End If
End Select
End Sub
I am asking just to clarify the issue.
You only want to call doubleclick procedure if any cell in column 1 to 4 have value
Or you want to check if corresponding row has value?
for option 1, you may use
If Application.CountA(Range("A1:D" & Rows.Count)) > 0 Then
'Your Code
End If
for second option
If Application.CountA(Range("A" & target.Row & ":D" & target.Row)) > 0 Then
'Your Code
End If
I tested above codes but in case of any mistake, we can modify them
I have a template that records hours worked by employees. Column 5 shows their contracted hours for the week and Column 14 shows additional hours they work. Part time staff (less than 37.5 hrs p/week) who work additional hours are paid a standard rate. However once they exceed 37.50 hours for the week they are paid at time and a half (this is recorded in a seperate column).
The code below picks up the total number of hours for the week (column 18) and if it exceeds 37.5 it will prompt the user to record some of the hours at time and a half. It's a failsafe way of ensuring people are paid correctly.
The code below works almost perfectly however if the contracted hours are less than 10, the message box pops up regardless. I think it is because I have a String data type for the hours in the code is as a String but I can't seem to get it to work with other data types. Any assistance would be much appreciated.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 14 Then
Dim I As Integer, CheckHours As Boolean
Dim MonthX As Worksheet
I = 6
CheckHours = False
Set MonthX = ThisWorkbook.ActiveSheet
Dim FT As String
FT = 37.5
Application.ScreenUpdating = False
'Use the Employee Number column to perform the check
Do While MonthX.Cells(I, 3) <> ""
'Declare variables
Dim ContractHours As String
Dim HoursPaid As String
Dim TotalHours As String
ContractHours = MonthX.Cells(I, 5)
HoursPaid = MonthX.Cells(I, 14)
TotalHours= MonthX.Cells(I, 18)
'If the contract hours plus the additional hours are greater than 37.50 then display warning
If TotalHours > FT Then
MsgBox "WARNING: Check the additional hours entered for " & _
MonthX.Cells(I, 2).Value & " " & MonthX.Cells(I, 1).Value & _
" as they will need to be split between Additional Basic and Overtime." & _
vbNewLine & vbNewLine & _
"Please refer to the Additional Hours Guidelines tab for more information.", vbOKOnly, "Please Check"
CheckHours = True
End If
I = I + 1
Loop
'Cancel boolean
If CheckHours = True Then
Cancel = True
End If
Application.ScreenUpdating = True
End If
End Sub
I don't know if your logic is right, but here's a rewrite that does the same thing as your code. There's a lot of extra stuff in your code that doesn't seem to have a purpose, so I removed it.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
Dim dTotalHours As Double
Dim aMsg(1 To 5) As String
Const dFULLTIME As Double = 37.5
i = 6
If Target.Column = 14 Then
Do While Len(Me.Cells(i, 3).Value) > 0
dTotalHours = Me.Cells(i, 18).Value
If dTotalHours > dFULLTIME Then
aMsg(1) = "WARNING: Check the additional hours entered for"
aMsg(2) = Me.Cells(i, 2).Value
aMsg(3) = Me.Cells(i, 3).Value
aMsg(4) = "as they will need to be split between Additional Basic and Overtime." & vbNewLine & vbNewLine
aMsg(5) = "Please refer to the Additional Hours Guidelines tab for more information."
MsgBox Join(aMsg, Space(1)), vbOKOnly, "Please Check"
End If
i = i + 1
Loop
End If
End Sub
Some notes
Excel stores numeric cell values as Doubles. If you're reading a number from a cell, there's really no reason to use anything but a Double.
When you're in the sheet's class module (where the events are), you can use the Me keyword to refer to the sheet. You refer to Activesheet, but what you really want is the sheet where the selection change occurred. They happen to be the same in this case, but for other events they may not be.
It's faster to check the length of a string rather than to check if <>"".
Your FT variable never changes making it not variable at all. A constant may be a better choice.
I use an array to store all the elements of a long message, then use Join to make the final string. Easier to read and maintain.
I'm a keyboard guy, so this hits closer to home for me that most, but a message box every time the selection changes? That means that if I attempt to use the arrow keys to get to the cell where I will fix the error, I will get constant message boxes. Brutal. Maybe the _Change event or _BeforeSave event are worth consideration.
Try declaring as a 'single' instead of a 'String'
We were told to declare decimal numbers as singles when at uni. It may solve your issue.
Or another thing I have notice but don't know if it will affect it, you don't have an ELSE with your IF statement
The following code may need a bit of tweaking, but it should come close to what you need. It implements several of the suggestions in the comments to your question. The source of your difficulty was the use of string variables to deal with numeric values.
I've declared FT, ContractHours, HoursPaid, and SumHours as Single variables, and Cancel as a Boolean (although you don't use it in the subroutine).
You can set "Option Explicit" - which requires that variables be declared - as the default for your code by choosing Tools/Options from the menu bar of the VBA editor and then check-marking the "Require Variable Declaration" option on the Editor tab.
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer, CheckHours As Boolean, Cancel As Boolean
Dim MonthX As Worksheet
Dim FT As Single
Dim ContractHours As Single
Dim HoursPaid As Single
Dim SumHours As Single
Set MonthX = ThisWorkbook.ActiveSheet
i = 6
FT = 37.5
If Target.Column = 14 Then
Application.ScreenUpdating = False
'Use the Employee Number column to perform the check
Do While MonthX.Cells(i, 3).Value <> ""
'Assign variables
ContractHours = MonthX.Cells(i, 5).Value
HoursPaid = MonthX.Cells(i, 14).Value
SumHours = MonthX.Cells(i, 18).Value
'When the contract hours plus the additional hours are greater than 37.50
' display warning
If SumHours > FT Then
MsgBox "WARNING: Check the additional hours entered for " & _
MonthX.Cells(i, 2).Value & " " & MonthX.Cells(i, 1).Value & _
" as they will need to be split between Additional Basic and Overtime." & _
vbNewLine & vbNewLine & _
"Please refer to the Additional Hours Guidelines tab for more information.", vbOKOnly, "Please Check"
CheckHours = True
End If
i = i + 1
Loop
'Cancel boolean
If CheckHours = True Then
Cancel = True
End If
Application.ScreenUpdating = True
End If
End Sub