VBA Validation between two Times

[Andy]

Good Afternoon.

I have some code (below) that adds validation to a certain cell to
allow the user only to fill in a value between a certain time, such as
11:00:00 AM and 11:59:00 AM in cell C22. There is similar code for
cells C11:C34.

The below code works fine when inputting the correct or incorrect
values but it seems to have a life of its own when copy and pasting
data into the cells.

For example when I paste in the following data to cells C11:C34 the
validation kicks in and says it is incorrect even though it is not. If
I input the same value into the cell directly there is no error and
the cell that sparks the message is not always the same one. The cells
are formatted hh:mm.

00:00
01:00
02:00
03:00
04:00
05:00
06:00
07:00
08:00
09:00
10:00
11:00
12:00
13:00
14:00
15:00
16:00
17:00
18:00
19:00
20:00
21:00
22:00
23:00


'
Set C22Valrange = Range("C22")
For Each cell In Target
If Union(cell, C22Valrange).Address = C22Valrange.Address Then
If cell.Value = "" Then
DataOk = True
Else
If cell.Value >= #11:00:00 AM# And cell.Value <= #11:59:00
AM# Then
DataOk = True
Else
DataOk = False
cell.Clear
cell.Locked = False
ActiveCell.Offset(-1, 0).Select
End If
End If
End If
Next cell
If Not DataOk Then
msg = "Please enter a time between 11:00 (11AM) and 11:59"
MsgBox msg, vbCritical
GoTo LeaveValidation
End If
'

Any help would be greatly appreciated

Andy

 

[Wouter HM]

Hi Andy,

Try this:


DataOk = True
Application.EnableEvents = False
Set C22Valrange = Range("C22")
For Each cell In Target
If Union(cell, C22Valrange).Address = C22Valrange.Address Then
If cell.Value = "" Then
DataOk = True
Else
If cell.Value >= #11:00:00 AM# And cell.Value <= #11:59:00
AM# Then
DataOk = True
Else
DataOk = False
cell.Clear
cell.Locked = False
ActiveCell.Offset(-1, 0).Select
End If
End If
' Cell C22 processed,
' other cells in target irrelevant
Exit For
End If
Next cell
If Not DataOk Then
msg = "Please enter a time between 11:00 (11AM) and 11:59"
MsgBox msg, vbCritical
GoTo LeaveValidation
End If
Application.EnableEvents = True


HTH,

Wouter

 

[Andy]

Hi there, and thanks for helping.

It doesn't seem to be any different with the code you pasted.

I tried removing all code but one section and still have the same
problem.
If I leave only the below code and paste the same block of values it
still shows the message box and clears the contents of the cell:
The cell that has the problem holds the value 5:00:00 AM formatted
hh:mm.

I'm at a loss as to what the problem is...

DataOk = True
Application.EnableEvents = False
Set C16Valrange = Range("C16")
For Each cell In Target
If Union(cell, C16Valrange).Address = C16Valrange.Address Then
If cell.Value = "" Then
DataOk = True
Else
If cell.Value >= #5:00:00 AM# And cell.Value <= #5:59:00
AM# Then
DataOk = True
Else
DataOk = False
cell.Clear
cell.Locked = False
ActiveCell.Offset(-1, 0).Select
End If
End If
Exit For
End If
Next cell
If Not DataOk Then
msg = "Please enter a time between 05:00 (5AM) and 05:59"
MsgBox msg, vbCritical
GoTo LeaveValidation
End If
Application.EnableEvents = True

 

[Andy]

I still haven't managed to find a solution to this - any help would be
appreciated.

As the above code is basically repeated for 23 other cells I'm not
sure if it can function properly when a block of cells are pasted in,
although I have tested by pasting a single row as well.

If necessary I can try to upload the template.

 

[ManicMiner17]

I still haven't managed to find a solution to this - any help would be
appreciated.

As the above code is basically repeated for 23 other cells I'm not
sure if it can function properly when a block of cells are pasted in,
although I have tested by pasting a single row as well.

If necessary I can try to upload the template.

Andy,

Apologies if I have missed the point of your question.

The test code below detects if date entered manually or pasted into a
cell in a range beginning C11 and ending at a variable cell below it in
Column C contains a time between 11:00 and 11:59.

The test code gives some messages to show how it is working.

Cells with invalid times are blanked.

You can enter a single time manually or paste a range into column C.

I hope this is of some help.


Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False

Dim C22ValRange As Range
Dim DataOK As Boolean
Dim msg As String
Dim rCell As Range
Dim sCell As Range
Dim endCell As Range

Set endCell = Cells(Rows.Count, "C").End(xlUp)

Set C22ValRange = Range("C11" & ":" & endCell.Address)
'MsgBox endCell.Address
'MsgBox C22ValRange.Address


For Each rCell In C22ValRange
For Each sCell In Target
If rCell.Address = sCell.Address Then
MsgBox "Cell " & rCell.Address
If rCell.Value >= #11:00:00 AM# And rCell.Value <= #11:59:00
AM# Then
MsgBox "Valid Time " & rCell.Address
Else
MsgBox "Invalid Time " & rCell.Address
rCell = ""
End If
End If
Next sCell
Next rCell
Application.EnableEvents = True
End Sub

 

[Andy]

Thanks for the reply.

Ideally I would like to cut the code down but the problem is that each
cell in column C needs different validation. Such as C11 should be
between 00:00 and 00:59, C12 should be between 01:00 and 01:59 and so
on until C34 so the code so far is below.

Dim C11Valrange, C12Valrange, C13Valrange, C14Valrange, C15Valrange,
C16Valrange, C17Valrange, _
C18Valrange, C19Valrange, C20Valrange, C21Valrange, C22Valrange,
C23Valrange, C24Valrange, _
C25Valrange, C26Valrange, C27Valrange, C28Valrange, C29Valrange,
C30Valrange, C31Valrange, _
C32Valrange, C33Valrange, C34Valrange As Range

DataOk = True
Application.EnableEvents = False
Set C11Valrange = Range("C11")
For Each cell In Target
If Union(cell, C11Valrange).Address = C11Valrange.Address Then
If cell.Value = "" Then
DataOk = True
Else
If cell.Value >= #12:00:00 AM# And cell.Value <= #12:59:00
AM# Then
DataOk = True
Else
DataOk = False
cell.Clear
cell.Locked = False
ActiveCell.Offset(-1, 0).Select
End If
End If
Exit For
End If
Next cell
If Not DataOk Then
msg = "Please enter a time between 00:00 (12AM) and 00:59"
MsgBox msg, vbCritical
GoTo LeaveValidation
End If

'
DataOk = True
Set C12Valrange = Range("C12")
For Each cell In Target
If Union(cell, C12Valrange).Address = C12Valrange.Address Then
If cell.Value = "" Then
DataOk = True
Else
If cell.Value >= #1:00:00 AM# And cell.Value <= #1:59:00
AM# Then
DataOk = True
Else
DataOk = False
cell.Clear
cell.Locked = False
ActiveCell.Offset(-1, 0).Select
End If
End If
Exit For
End If
Next cell
If Not DataOk Then
msg = "Please enter a time between 01:00 (1AM) and 01:59"
MsgBox msg, vbCritical
GoTo LeaveValidation
End If


and so on...

 

[ManicMiner17]

Thanks for the reply.

Ideally I would like to cut the code down but the problem is that each
cell in column C needs different validation. Such as C11 should be
between 00:00 and 00:59, C12 should be between 01:00 and 01:59 and so
on until C34 so the code so far is below.

Hi Andy,

For your range C11:C34 this code should identify which cells have a
valid time using your defined categories.

I haven't tried to mimic the action of your code, just what I think you
are trying to achieve with the time comparison and the ability to paste
into the range C11:C34 and still get the result correct comparison.

The code assumes the source paste range and the source range are
formatted as time.

It isn't particularly short as the time boundaries have to be defined
somewhere.

I'd thought of trying to use an enum but I haven't figured that out yet.

Just back from a 5 hr drive so my mind is not at its sharpest


Option Explicit
Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False

Dim C22ValRange As Range
Dim DataOK As Boolean
Dim msg As String
Dim rCell As Range
Dim sCell As Range
Dim endCell As Range
Dim cellRow As Long

Dim Times(24, 2) As Date


Times(1, 1) = #12:00:00 AM#
Times(1, 2) = #12:59:00 AM#
Times(2, 1) = #1:00:00 AM#
Times(2, 2) = #1:59:00 AM#
Times(3, 1) = #2:00:00 AM#
Times(3, 2) = #2:59:00 AM#
Times(4, 1) = #3:00:00 AM#
Times(4, 2) = #3:59:00 AM#
Times(5, 1) = #4:00:00 AM#
Times(5, 2) = #4:59:00 AM#
Times(6, 1) = #5:00:00 AM#
Times(6, 2) = #5:59:00 AM#
Times(7, 1) = #6:00:00 AM#
Times(7, 2) = #6:59:00 AM#
Times(8, 1) = #7:00:00 AM#
Times(8, 2) = #7:59:00 AM#
Times(9, 1) = #8:00:00 AM#
Times(9, 2) = #8:59:00 AM#
Times(10, 1) = #9:00:00 AM#
Times(10, 2) = #9:59:00 AM#
Times(11, 1) = #10:00:00 AM#
Times(11, 2) = #10:59:00 AM#
Times(12, 1) = #11:00:00 AM#
Times(12, 2) = #11:59:00 AM#
Times(13, 1) = #12:00:00 PM#
Times(13, 2) = #12:59:00 PM#
Times(14, 1) = #1:00:00 PM#
Times(14, 2) = #1:59:00 PM#
Times(15, 1) = #2:00:00 PM#
Times(15, 2) = #2:59:00 PM#
Times(16, 1) = #3:00:00 PM#
Times(16, 2) = #3:59:00 PM#
Times(17, 1) = #4:00:00 PM#
Times(17, 2) = #4:59:00 PM#
Times(18, 1) = #5:00:00 PM#
Times(18, 2) = #5:59:00 PM#
Times(19, 1) = #6:00:00 PM#
Times(19, 2) = #6:59:00 PM#
Times(20, 1) = #7:00:00 PM#
Times(20, 2) = #7:59:00 PM#
Times(21, 1) = #8:00:00 PM#
Times(21, 2) = #8:59:00 PM#
Times(22, 1) = #9:00:00 PM#
Times(22, 2) = #9:59:00 PM#
Times(23, 1) = #10:00:00 PM#
Times(23, 2) = #10:59:00 PM#
Times(24, 1) = #11:00:00 PM#
Times(24, 2) = #11:59:00 PM#

Set endCell = Cells(Rows.Count, "C").End(xlUp)

Set C22ValRange = Range("C11" & ":" & endCell.Address)

For Each rCell In C22ValRange
For Each sCell In Target
If rCell.Address = sCell.Address Then
MsgBox "Cell " & rCell.Address
cellRow = rCell.Row - 10
MsgBox cellRow
If rCell.Value >= Times(cellRow, 1) And rCell.Value <=
Times(cellRow, 2) Then
MsgBox "Valid Time " & rCell.Address
Else
MsgBox "Invalid Time " & rCell.Address
rCell = ""
End If
End If
Next sCell
Next rCell
Application.EnableEvents = True
End Sub

 

[Andy]

Thanks again for the help!

Although your code shortens my own considerably it doesn't seem to
solve my problem.

A rundown of what's happening now:

I try pasting this set of data from a different workbook in format
hh:mm
00:00
01:00
02:00
03:00
04:00
05:00
06:00
07:00
08:00
09:00
10:00
11:00
12:00
13:00
14:00
15:00
16:00
17:00
18:00
19:00
20:00
21:00
22:00
23:00

into cell C11

Most of the messages that pop up show as valid, as you would expect
but some cells do not even though the data is correct and the format
is EXACTLY the same.

The below are the ones that paste properly, the ones that show as
invalid and cleared are marked as such

00:00
01:00
02:00
03:00
04:00
Invalid
06:00
07:00
Invalid
09:00
10:00
Invalid
12:00
13:00
Invalid
15:00
16:00
Invalid
18:00
19:00
Invalid
21:00
22:00
Invalid

There is a strange pattern there...

Any further help would be appreciated - I'll be here banging my head
against my desk =)

 

[Andy]

To test a bit more thoroughly I tried copying only your code to a
brand new workbook and it still seems to give the same problem
although the invalid cells are different.

I typed 00:00 into the first cell of another workbook, copying it down
to 23:00 then copied it over to the coded workbook. Same formats again.

 

[ManicMiner17]

To test a bit more thoroughly I tried copying only your code to a
brand new workbook and it still seems to give the same problem
although the invalid cells are different.

I typed 00:00 into the first cell of another workbook, copying it down
to 23:00 then copied it over to the coded workbook. Same formats again.

Andy,

I have seen this but only if the range being pasted has been created by
dragging down.

A range created by typing directly in the cell to be pasted hasn't given
me this problem.

 

[ManicMiner17]

To test a bit more thoroughly I tried copying only your code to a
brand new workbook and it still seems to give the same problem
although the invalid cells are different.

I typed 00:00 into the first cell of another workbook, copying it down
to 23:00 then copied it over to the coded workbook. Same formats again.

Andy,

Try putting 0:00:59 in a cell.

Drag down. Select the resulting range.

Paste into C11.

You shouldn't get any errors.

 

[ManicMiner17]

Andy,

This works whether the time is entered manually, or created using
drag-down to copy then pasted.

There seem to be subtle differences between times entered manually and
those which occur if the time is entered directly to the cell.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False

Dim C22ValRange As Range
Dim DataOK As Boolean
Dim msg As String
Dim rCell As Range
Dim sCell As Range
Dim endCell As Range
Dim cellRow As Long

Dim Times(25) As Date


Times(1) = 0 '12AM
Times(2) = 4.16666666666666E-02 '1AM
Times(3) = 0.083333333 '2AM
Times(4) = 0.125 '3AM
Times(5) = 0.166666666666666 '4AM
Times(6) = 0.208333333333333 '5AM
Times(7) = 0.25 '6AM
Times(8) = 0.291666666666666 '7AM
Times(9) = 0.333333333333333 '8AM
Times(10) = 0.375 '9AM
Times(11) = 0.416666666666666 '10AM
Times(12) = 0.458333333333333 '11AM
Times(13) = 0.5 '12PM
Times(14) = 0.541666666666666 '1PM
Times(15) = 0.583333333333333 '2PM
Times(16) = 0.625 '3PM
Times(17) = 0.666666666666666 '4PM
Times(18) = 0.708333333333333 '5PM
Times(19) = 0.75 '6PM
Times(20) = 0.791666666666666 '7PM
Times(21) = 0.833333333333333 '8PM
Times(22) = 0.875 '9PM
Times(23) = 0.916666666666666 '10PM
Times(24) = 0.958333333333333 '11PM
Times(25) = 0.999999999999999

Set endCell = Cells(Rows.Count, "C").End(xlUp)

Set C22ValRange = Range("C11" & ":" & endCell.Address)

For Each rCell In C22ValRange
For Each sCell In Target
If rCell.Address = sCell.Address Then
MsgBox "Cell " & rCell.Address
cellRow = rCell.Row - 10
MsgBox cellRow
If Round(rCell.Value, 16) >= Round(Times(cellRow), 16) And
rCell.Value <= Times(cellRow + 1) Then
Debug.Print rCell.Value
MsgBox "Valid Time " & rCell.Address
Else
MsgBox "Invalid Time " & rCell.Address
Debug.Print rCell.Value
rCell = ""
End If
End If
Next sCell
Next rCell
Application.EnableEvents = True
End Sub

 

[Andy]

ManicMiner17 you're a legend!

It works exactly as I hoped. The reason it was preferable to get to
this stage is that the template will be used by hundreds of people in
many locations and as you know, people always find a way to break
things. At least now I have most of the more likely possibilities
covered.

Many thanks again for all the time you've put into this. I really
appreciate it!

 

[Andy]

It seems I was a little hasty in celebrating!

Some cells such as 08:00 - 08:59 allow 9:00 as well. 9:01 shows as
invalid but it allows 9:00. I'm sure some tweaking here and there
could fix this problem but it's odd that it doesn't apply to most of
the other cells.

Another issue is there doesn't seem to be any non time validation now.
What I mean by this is if I type some text into the cell the code
doesn't have a problem with it.

As I mentioned above, a lot of users will be using this template and
the more foolproof I can make these cells (they are the most important
in the whole template) the less hassle our admin team will have to
endure.


I'll try to adapt the your code but any further help is of course
appreciated!

 

[ManicMiner17]

It seems I was a little hasty in celebrating!

Some cells such as 08:00 - 08:59 allow 9:00 as well. 9:01 shows as
invalid but it allows 9:00. I'm sure some tweaking here and there
could fix this problem but it's odd that it doesn't apply to most of
the other cells.

Another issue is there doesn't seem to be any non time validation now.
What I mean by this is if I type some text into the cell the code
doesn't have a problem with it.

As I mentioned above, a lot of users will be using this template and
the more foolproof I can make these cells (they are the most important
in the whole template) the less hassle our admin team will have to
endure.


I'll try to adapt the your code but any further help is of course
appreciated!

Andy,

I had a <= in the following line. Lose the = and see how it performs.

If rCell.Value >= Times(cellRow) And rCell.Value < Times(cellRow + 1) Then

 

[ManicMiner17]

Another issue is there doesn't seem to be any non time validation now.
What I mean by this is if I type some text into the cell the code
doesn't have a problem with it.

Hi Andy,

Not sure what is happening at your end. If I type "Andy" into one of the
cells it throws up the "invalid time" message box and clears the cell.

I've just looked for valid times. Everything else is an invalid time
which includes text.

 

[ManicMiner17]

Andy,

replace

Set endCell = Cells(Rows.Count, "C").End(xlUp)
Set C22ValRange = Range("C11" & ":" & endCell.Address)

with

Set C22ValRange = Range("C11:C34")

Your range doesn't change in length and the first code will just give
subscript out of range errors if the users get creative with their paste
ranges.

 

[Andy]

The last code you wrote throws out a few errors when I test it in a
new workbook.

It doesn't accept the correct time even if typed in, if I copy a whole
range in it shows error 13 - Type mismatch on "j = CLng(d)" and when
data is deleted it shows the invalid data msgbox.

However with the small tweak you suggested to the original code it
seems to work perfectly! I tested all above issues including the text
validation and everything seems to work as it should. Extremely happy
with it - I was beginning to lose hope!

So thank you very much again! Your help is very much appreciated.

Here is the winning code:

Application.EnableEvents = False

Dim C22ValRange As Range
Dim DataOK As Boolean
Dim msg As String
Dim rCell As Range
Dim sCell As Range
Dim endCell As Range
Dim cellRow As Long

Dim Times(25) As Date

Times(1) = 0 '12AM
Times(2) = 4.16666666666666E-02 '1AM
Times(3) = 0.083333333 '2AM
Times(4) = 0.125 '3AM
Times(5) = 0.166666666666666 '4AM
Times(6) = 0.208333333333333 '5AM
Times(7) = 0.25 '6AM
Times(8) = 0.291666666666666 '7AM
Times(9) = 0.333333333333333 '8AM
Times(10) = 0.375 '9AM
Times(11) = 0.416666666666666 '10AM
Times(12) = 0.458333333333333 '11AM
Times(13) = 0.5 '12PM
Times(14) = 0.541666666666666 '1PM
Times(15) = 0.583333333333333 '2PM
Times(16) = 0.625 '3PM
Times(17) = 0.666666666666666 '4PM
Times(18) = 0.708333333333333 '5PM
Times(19) = 0.75 '6PM
Times(20) = 0.791666666666666 '7PM
Times(21) = 0.833333333333333 '8PM
Times(22) = 0.875 '9PM
Times(23) = 0.916666666666666 '10PM
Times(24) = 0.958333333333333 '11PM
Times(25) = 0.999999999999999

Set C22ValRange = Range("C11:C34")

For Each rCell In C22ValRange
For Each sCell In Target
If rCell.Address = sCell.Address Then
MsgBox "Cell " & rCell.Address
cellRow = rCell.Row - 10
MsgBox cellRow
If rCell.Value >= Times(cellRow) And rCell.Value <
Times(cellRow + 1) Then
Debug.Print rCell.Value
MsgBox "Valid Time " & rCell.Address
Else
MsgBox "Invalid Time " & rCell.Address
Debug.Print rCell.Value
rCell = ""
End If
End If
Next sCell
Next rCell
Application.EnableEvents = True