The purpose of this code, located in the “Scorecard” worksheet module
is to insure users enter numeric weighting values (formatted percent
in four cell ranges. The sum of the four weights cannot be greate
than 100%. I plan to enforce this rule by preventing users for
leaving the “Scorecard” worksheet, other than closing without saving
without entering a numeric value greater than zero:

Cell Range Name
G26:I26 Customer Weighting
G44:I44 Financial Weighting
AG26:AI26 L & G Weighting
AG44:AI44 Process Weighting

Using an Auto_Open sub in Module 1, the workbook opens on th
“Scorecard” worksheet, and the four cell ranges are initially blank.

If the user does not enter proper values, I want a message to come u
saying “A weight greater than zero must be entered for Custome
Weighting” - which would apply to cell range G26:I26. The messag
would change to L&G Weighting, etc., depending on which cell(s) remai
blank or not greater than zero. If more than one cell offends, th
message would include the names of offending cells.

Users leave the “Scorecard” worksheet for another worksheet by clickin
on a hyperlinked cell range, which has a (text) number, 1 through 4, i
it. (A command button would work very easily here, but the boss says n
– doesn’t like how a command button looks – and he’s right, the numbe
does look neat.)

Number Range What clicking does
"1” C12:D16 takes user to the “Customer” worksheet
“2” C30:D34 takes user to the “Financial” worksheet
“3” AC12:AD16 takes user to the “L & G” worksheet
“4” AC30:AD34 takes user to the “Process” worksheet

Once populated, saved, and opened again by the user, the rule of value
greater than zero continues to apply, with the same warning message.

The code below this is not working. Can someone unravel this for me?
Is a function the way to go, as opposed to a sub? The “message
portion of the code need change.

Private Function CheckRange(Cell As Range)
Dim sMsg As String
Dim cellOK As Boolean
cellOK = False
If IsEmpty(Cell) Then
cellOK = False
ElseIf IsNumeric(Cell.Vallue) = False Then
cellOK = True
Else
If Cell.Value <= 0 Then
cellOK = False
End If
End If
If cellOK Then
'do nothing
Else
sMsg = "Weight for Cell(s)" & _
Cell.MergeArea.Address(False, False) & _
"must be entered, and must be greater than zero."
End If
CheckRange = sMsg & vbCrLf
End Functio

--
Message posted from http://www.ExcelForum.com