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

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

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

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.

On 12/08/2010 10:18, Andy wrote:
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

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...

Andy,

An alternative approach:

Option Explicit


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

Dim C22ValRange As Range
Dim rCell As Range
Dim sCell As Range
Dim endCell As Range
Dim cellRow As Long
Dim x As String
Dim d As Variant
Dim j As Long
Dim y As Date

Dim Times(25) As Long


Times(1) = 0 '12AM
Times(2) = 1 '1AM
Times(3) = 2 '2AM
Times(4) = 3 '3AM
Times(5) = 4 '4AM
Times(6) = 5 '5AM
Times(7) = 6 '6AM
Times(8) = 7 '7AM
Times(9) = 8 '8AM
Times(10) = 9 '9AM
Times(11) = 10 '10AM
Times(12) = 11 '11AM
Times(13) = 12 '12PM
Times(14) = 13 '1PM
Times(15) = 14 '2PM
Times(16) = 15 '3PM
Times(17) = 16 '4PM
Times(18) = 17 '5PM
Times(19) = 18 '6PM
Times(20) = 19 '7PM
Times(21) = 20 '8PM
Times(22) = 21 '9PM
Times(23) = 22 '10PM
Times(24) = 23 '11PM
Times(25) = 24

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
cellRow = rCell.Row - 10
y = rCell.Value
x = CStr(y)
d = Left(x, 2)
j = CLng(d)
If j = Times(cellRow) And j < Times(cellRow + 1) Then
Debug.Print j
MsgBox "Valid Time " & rCell.Address
Else
MsgBox "Invalid Time " & rCell.Address
Debug.Print j
rCell = ""
End If
End If
Next sCell
Next rCell
Application.EnableEvents = True
End Sub

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.

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