Validate Cell Value

[Mark]

Hi,
I’m trying to create a way to validate a cell value, or score, when the User
tabs off of the cell. The first possible cell that will receive a score will
be C13 and there can be an indeterminate number of columns and rows, however
I don’t believe that scores will be entered beyond column AB nor past row 50.
The maximum possible score in each column is located in row 12 respectively
and I want to make sure that the score in each column does not exceed the
value in row 12. For example, column E (from row 13 downward) may contain
scores related to fractions aptitude with the maximum possible score of 10 in
cell E12. Currently, I’m using Excel’s built in data validation feature, but
some people have figured out how to get around it. Is there an event
procedure, or other process, that will do the validation process?
Thanks,
Mark

 

[JLGWhiz]

I did not test this but have included notes so you can
get the idea of how it is supposed to work. Copy it to
the Worksheet code module.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long, sh As Worksheet
sh = ActiveSheet
'find last row with data and assign variable
lr = lastRow = sh.Cells.Find(What:="*", After:=sh.Range("A1"), _
LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
'Define the range for making entries
Set rng = sh.Range("A13:AB" & lr)
'make sure there is a value in the cell
If Not Intersect(Taget, rng) Is Nothing Then
'validate against value in row 12
If Target > sh.Cells(12, Target.Column) Then
'notify user that value is too large
MsgBox "Exceeds Authorized Limit"
'remove the entry
Target = ""
Exit Sub
End If
End If
End Sub

 

[Mark]

Thank you so much, but I cant seem to trip it - or make it run. I'm attaching
the entire code from the class module, since I'm not a programmer, I'm
probably doing something wrong.

Option Explicit
Public WithEvents XL As Application

Private Sub Class_Terminate()
Set XL = Nothing
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'JLGWhiz
Dim lr As Long, sh As Worksheet
sh = ActiveSheet
'find last row with data and assign variable
lr = lastrow = sh.Cells.Find(What:="*", After:=sh.Range("A1"), _
LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
'Define the range for making entries
Set Rng = sh.Range("A13:AB" & lr)
'make sure there is a value in the cell
If Not Intersect(Taget, Rng) Is Nothing Then
'validate against value in row 12
If Target > sh.Cells(12, Target.Column) Then
'notify user that value is too large
MsgBox "Score Exceeds Maximum Value", vbOKOnly
'remove the entry
Target = ""
Exit Sub
End If
End If
End Sub

 

[Tim Zych]

Here's a macro which you can start with. Paste this in the worksheet module
that you want to validate cell entries for. Play around with it. It does not
dot every i or cross every t. For example, what are the rules if row 12 does
not have a MAX value entered yet?...so you can add further business rules as
needed. It also assumes that cell entries are single cell. So multi-cell
entries (e.g. pasting data) will result in only the top-left cell of that
particular action to be evaluated, so you might want to enforce that more
strictly, and/or accommodate multi-cell changes. As you might imagine,
creating a bullet-proof macro which accommodates every possible scenario is
not a trivial task. There are many ways to thwart the intent of a macro, and
some people have fun trying to figure out how to do so.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cellEntry As Range, cellMax As Range, rngArea As Range
With Target
' This is the typed in cell
Set cellEntry = .Cells(1, 1)
' This is the MAX cell in the same column
Set cellMax = .Parent.Cells(12, .Column)
' This is the working area. Adjust as needed
Set rngArea = .Parent.Range(.Parent.Range("C13"), _
.Parent.Range("AB50"))
End With
' Make sure the entered value is within the working area
If Not Application.Intersect(cellEntry, rngArea) Is Nothing Then
' Check if a number, and display a message if not.
If Not IsNumeric(cellEntry.Value) Then
MsgBox "The value you entered (" & cellEntry.Value & _
") is not a number." & vbLf & vbLf & "Try again."
Application.EnableEvents = False
cellEntry.Value = ""
Application.EnableEvents = True
cellEntry.Select
' Compare the entry to the MAX cell
ElseIf cellEntry.Value > cellMax.Value Then
MsgBox "The number you entered (" & cellEntry.Value & _
") is too big. It cannot be larger than " & _
cellMax.Value & vbLf & vbLf & "Try again."
Application.EnableEvents = False
cellEntry.Value = ""
Application.EnableEvents = True
cellEntry.Select
End If
End If

End Sub


--
Regards,
Tim Zych

http://www.higherdata.com
Workbook Compare - Excel data comparison utility

http://www.higherdata.com/sql/batchsqlfromexcel.html
Create batch SQL statements from Excel

 

[Mark]

Thanks, Tim, this seems to work pretty good. However, I need to apply this
macro over three different sheets. How would I go about doing that?

These sheets are created off of a template and all have column headings that
list individual tests, and the maximum score will always be in row 12 just
below the test name, so I'm hoping no one tries to stick a number in just
anywhere. Columns A & B will contain ID numbers and names respectively and
there should not be any pasting of data. Hopefully, I can protect the
integrity of the process by using VBA.
Mark

 

[Tim Zych]

To reuse the validation code:

Rename the Worksheet_Change procedure to something more friendly and make it
Public. The code goes in a regular module:

Public Sub ValidateSheet(ByVal Target As Range)
' copy code with no changes
End Sub

Then in as many sheets as you want to validate, add to the sheet modules:

Private Sub Worksheet_Change(ByVal Target As Range)
Call ValidateSheet(Target)
End Sub

 

[Mark]

Thank you so much, Tim. That worked great!
Mark

To reuse the validation code:

Rename the Worksheet_Change procedure to something more friendly and make it
Public. The code goes in a regular module:

Public Sub ValidateSheet(ByVal Target As Range)
' copy code with no changes
End Sub

Then in as many sheets as you want to validate, add to the sheet modules:

Private Sub Worksheet_Change(ByVal Target As Range)
Call ValidateSheet(Target)
End Sub

--
Regards,
Tim Zych
http://www.higherdata.com
Workbook Compare - Excel data comparison utility

 

[JLGWhiz]

Yes, I should have tested it. I had a couple of typos and one bad syntax.
I see that Tim has helped solve the problem, but here is the corrected code
for clarity sake.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long, sh As Worksheet
Set sh = ActiveSheet
'find last row with data and assign variable
lr = sh.Cells.Find(What:="*", After:=sh.Range("A1"), _
LookAt:=xlPart, LookIn:=xlValues, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
'Define the range for making entries
Set rng = sh.Range("A13:AB" & lr)
'make sure there is a value in the cell
If Not Intersect(Target, rng) Is Nothing Then
'validate against value in row 12
If Target > sh.Cells(12, Target.Column) Then
'notify user that value is too large
MsgBox "Exceeds Authorized Limit"
'remove the entry
Target = ""
Exit Sub
End If
End If
End Sub

 

[Mark]

Thanks, JLGWhiz, I appreciate your help and I'll give your code a try, too.
Mark

 

[Mark]

Hi Tim,
When I went to apply your solution to the sheets in the template copies, I
get a
"Compile error: Sub or Function not defined".

The Call is in each individual sheet of the template and the work sheet
change event resides in Personal.xls*.

Any idea as to what I'm doing wrong?
Mark

 

[Tim Zych]

Ok, so instead of Call, use:

Private Sub Worksheet_Change(ByVal Target As Range)
Run "Personal.xls!ValidateSheet", Target
End Sub

 

[Mark]

Excellent! Thanks, Tim, you're a genius!

Ok, so instead of Call, use:

Private Sub Worksheet_Change(ByVal Target As Range)
Run "Personal.xls!ValidateSheet", Target
End Sub

--
Regards,
Tim Zych
http://www.higherdata.com
Workbook Compare - Excel data comparison utility