There are four cells (merged cell ranges) I want users to
fill data into before leaving the worksheet (worksheet
name is "Scorecard"); G26:I26, AG26:AI26, G44:I44, and
AG44:AI44. I have an Auto_Open sub in place to open the
workbook on this "Scorecard" worksheet. These four cells
are weighting factors and the numbers, formatted percent,
must equal 100%. Also, there must be a number entry in
each of the four cells, even if it is zero. If the user
does not make an entry (blank cell) a message must come up
saying "Weight for cell *** is required." If they leave
multiple cells blank, the message would include those
cells as well. Users cannot leave the worksheet until all
four cells are populated.

What would the code be? Would I put the code in the
worksheet code object, or in Module 1?

Phil,

Are you ready for this?

This code goes in a normal code module, Module 1

'---------------------------------------------------------------------------
Public Function ValidScorecard() As Boolean
Dim sMsg As String

ValidScorecard = True

sMsg = sMsg & CheckRange("G26")

sMsg = sMsg & CheckRange("AG26")

sMsg = sMsg & CheckRange("G44")

sMsg = sMsg & CheckRange("AG44")

If Len(sMsg) 0 Then
MsgBox sMsg
ValidScorecard = False
End If

End Function

Private Function CheckRange(cell As String)
Dim sMsg As String

With Worksheets("Scorecard")
If IsEmpty(.Range(cell)) Then
If .Range(cell).MergeArea.Address(False, False) < cell Then
sMsg = "Weight for cell(s) " & _
.Range(cell).MergeArea.Address & _
" is required"
Else
sMsg = "Weight for cell " & _
.Range(cell).Address & _
" is required"
End If
CheckRange = sMsg & vbCrLf
End If
End With

End Function

'---------------------------------------------------------------------------


This following code goes in the Scorecard worksheet code module


'---------------------------------------------------------------------------
Private Sub Worksheet_Deactivate()

If Not ValidScorecard Then
Worksheets("Scorecard").Activate
End If
End Sub

'---------------------------------------------------------------------------

and finally, this goes in the ThisWorkbook code m odule


'---------------------------------------------------------------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If ActiveSheet.Name = "Scorecard" Then
If Not ValidScorecard Then
Cancel = True
Worksheets("Scorecard").Activate
End If
End If
End Sub

'---------------------------------------------------------------------------

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Phil Hageman" wrote in message
...
There are four cells (merged cell ranges) I want users to
fill data into before leaving the worksheet (worksheet
name is "Scorecard"); G26:I26, AG26:AI26, G44:I44, and
AG44:AI44. I have an Auto_Open sub in place to open the
workbook on this "Scorecard" worksheet. These four cells
are weighting factors and the numbers, formatted percent,
must equal 100%. Also, there must be a number entry in
each of the four cells, even if it is zero. If the user
does not make an entry (blank cell) a message must come up
saying "Weight for cell *** is required." If they leave
multiple cells blank, the message would include those
cells as well. Users cannot leave the worksheet until all
four cells are populated.

What would the code be? Would I put the code in the
worksheet code object, or in Module 1?

Bob, Thanks for your reply - you're right, I am stepping
into the deep end. A request: I now have an additional
requirement that not only must the cells be populated, the
values entered must be greater than zero. Could you add
that feature into the code? Thanks, Phil
-----Original Message-----
Phil,

Are you ready for this?

This code goes in a normal code module, Module 1

'---------------------------------------------------------
------------------
Public Function ValidScorecard() As Boolean
Dim sMsg As String

ValidScorecard = True

sMsg = sMsg & CheckRange("G26")

sMsg = sMsg & CheckRange("AG26")

sMsg = sMsg & CheckRange("G44")

sMsg = sMsg & CheckRange("AG44")

If Len(sMsg) 0 Then
MsgBox sMsg
ValidScorecard = False
End If

End Function

Private Function CheckRange(cell As String)
Dim sMsg As String

With Worksheets("Scorecard")
If IsEmpty(.Range(cell)) Then
If .Range(cell).MergeArea.Address(False,
False) < cell Then
sMsg = "Weight for cell(s) " & _
.Range(cell).MergeArea.Address & _
" is required"
Else
sMsg = "Weight for cell " & _
.Range(cell).Address & _
" is required"
End If
CheckRange = sMsg & vbCrLf
End If
End With

End Function

'---------------------------------------------------------
------------------


This following code goes in the Scorecard worksheet code
module


'---------------------------------------------------------
------------------
Private Sub Worksheet_Deactivate()

If Not ValidScorecard Then
Worksheets("Scorecard").Activate
End If
End Sub

'---------------------------------------------------------
------------------

and finally, this goes in the ThisWorkbook code m odule


'---------------------------------------------------------
------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If ActiveSheet.Name = "Scorecard" Then
If Not ValidScorecard Then
Cancel = True
Worksheets("Scorecard").Activate
End If
End If
End Sub

'---------------------------------------------------------
------------------

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Phil Hageman"
wrote in message
...
There are four cells (merged cell ranges) I want users
to
fill data into before leaving the worksheet (worksheet
name is "Scorecard"); G26:I26, AG26:AI26, G44:I44,
and
AG44:AI44. I have an Auto_Open sub in place to open the
workbook on this "Scorecard" worksheet. These four
cells
are weighting factors and the numbers, formatted
percent,
must equal 100%. Also, there must be a number entry in
each of the four cells, even if it is zero. If the user
does not make an entry (blank cell) a message must come
up
saying "Weight for cell *** is required." If they leave
multiple cells blank, the message would include those
cells as well. Users cannot leave the worksheet until
all
four cells are populated.

What would the code be? Would I put the code in the
worksheet code object, or in Module 1?



.

Phil,

Here it is. Just replace the CheckRange function with this code

Private Function CheckRange(cell As String)
Dim sMsg As String

With Worksheets("Scorecard")
If IsEmpty(.Range(cell)) Or .Range(cell).Value <= 0 Then
If .Range(cell).MergeArea.Address(False, False) < cell Then
sMsg = "Weight for cell(s) " & _
.Range(cell).MergeArea.Address & _
" must be entered, and must be 0"
Else
sMsg = "Weight for cell " & _
.Range(cell).Address & _
" must be entered, and must be 0"
End If
CheckRange = sMsg & vbCrLf
End If
End With

End Function

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Phil Hageman" wrote in message
...
Bob, Thanks for your reply - you're right, I am stepping
into the deep end. A request: I now have an additional
requirement that not only must the cells be populated, the
values entered must be greater than zero. Could you add
that feature into the code? Thanks, Phil

Bob, I receive a compile error: Type Mismatch,

Public Function ValidScorecard() As Boolean
Dim sMsg As String
ValidScorecard = True
sMsg = sMsg & CheckRange("G26")
"G26" is highlighted


-----Original Message-----
Bob, Thanks for your reply - you're right, I am stepping
into the deep end. A request: I now have an additional
requirement that not only must the cells be populated,
the
values entered must be greater than zero. Could you add
that feature into the code? Thanks, Phil
-----Original Message-----
Phil,

Are you ready for this?

This code goes in a normal code module, Module 1

'--------------------------------------------------------
-
------------------
Public Function ValidScorecard() As Boolean
Dim sMsg As String

ValidScorecard = True

sMsg = sMsg & CheckRange("G26")

sMsg = sMsg & CheckRange("AG26")

sMsg = sMsg & CheckRange("G44")

sMsg = sMsg & CheckRange("AG44")

If Len(sMsg) 0 Then
MsgBox sMsg
ValidScorecard = False
End If

End Function

Private Function CheckRange(cell As String)
Dim sMsg As String

With Worksheets("Scorecard")
If IsEmpty(.Range(cell)) Then
If .Range(cell).MergeArea.Address(False,
False) < cell Then
sMsg = "Weight for cell(s) " & _
.Range(cell).MergeArea.Address &
_
" is required"
Else
sMsg = "Weight for cell " & _
.Range(cell).Address & _
" is required"
End If
CheckRange = sMsg & vbCrLf
End If
End With

End Function

'--------------------------------------------------------
-
------------------


This following code goes in the Scorecard worksheet code
module


'--------------------------------------------------------
-
------------------
Private Sub Worksheet_Deactivate()

If Not ValidScorecard Then
Worksheets("Scorecard").Activate
End If
End Sub

'--------------------------------------------------------
-
------------------

and finally, this goes in the ThisWorkbook code m odule


'--------------------------------------------------------
-
------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If ActiveSheet.Name = "Scorecard" Then
If Not ValidScorecard Then
Cancel = True
Worksheets("Scorecard").Activate
End If
End If
End Sub

'--------------------------------------------------------
-
------------------

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Phil Hageman"
wrote in message
...
There are four cells (merged cell ranges) I want users
to
fill data into before leaving the worksheet (worksheet
name is "Scorecard"); G26:I26, AG26:AI26, G44:I44,
and
AG44:AI44. I have an Auto_Open sub in place to open
the
workbook on this "Scorecard" worksheet. These four
cells
are weighting factors and the numbers, formatted
percent,
must equal 100%. Also, there must be a number entry in
each of the four cells, even if it is zero. If the
user
does not make an entry (blank cell) a message must
come
up
saying "Weight for cell *** is required." If they
leave
multiple cells blank, the message would include those
cells as well. Users cannot leave the worksheet until
all
four cells are populated.

What would the code be? Would I put the code in the
worksheet code object, or in Module 1?



.

.

Phil,

Is this with the original or revised version? Although both should be okay,
I have tried them both with and without merged cells.

Want to send me the workbook to look at (do the usual with the email
address)

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Phil Hageman" wrote in message
...
Bob, I receive a compile error: Type Mismatch,

Public Function ValidScorecard() As Boolean
Dim sMsg As String
ValidScorecard = True
sMsg = sMsg & CheckRange("G26")
"G26" is highlighted


-----Original Message-----
Bob, Thanks for your reply - you're right, I am stepping
into the deep end. A request: I now have an additional
requirement that not only must the cells be populated,
the
values entered must be greater than zero. Could you add
that feature into the code? Thanks, Phil
-----Original Message-----
Phil,

Are you ready for this?

This code goes in a normal code module, Module 1

'--------------------------------------------------------
-
------------------
Public Function ValidScorecard() As Boolean
Dim sMsg As String

ValidScorecard = True

sMsg = sMsg & CheckRange("G26")

sMsg = sMsg & CheckRange("AG26")

sMsg = sMsg & CheckRange("G44")

sMsg = sMsg & CheckRange("AG44")

If Len(sMsg) 0 Then
MsgBox sMsg
ValidScorecard = False
End If

End Function

Private Function CheckRange(cell As String)
Dim sMsg As String

With Worksheets("Scorecard")
If IsEmpty(.Range(cell)) Then
If .Range(cell).MergeArea.Address(False,
False) < cell Then
sMsg = "Weight for cell(s) " & _
.Range(cell).MergeArea.Address &
_
" is required"
Else
sMsg = "Weight for cell " & _
.Range(cell).Address & _
" is required"
End If
CheckRange = sMsg & vbCrLf
End If
End With

End Function

'--------------------------------------------------------
-
------------------


This following code goes in the Scorecard worksheet code
module


'--------------------------------------------------------
-
------------------
Private Sub Worksheet_Deactivate()

If Not ValidScorecard Then
Worksheets("Scorecard").Activate
End If
End Sub

'--------------------------------------------------------
-
------------------

and finally, this goes in the ThisWorkbook code m odule


'--------------------------------------------------------
-
------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If ActiveSheet.Name = "Scorecard" Then
If Not ValidScorecard Then
Cancel = True
Worksheets("Scorecard").Activate
End If
End If
End Sub

'--------------------------------------------------------
-
------------------

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Phil Hageman"
wrote in message
...
There are four cells (merged cell ranges) I want users
to
fill data into before leaving the worksheet (worksheet
name is "Scorecard"); G26:I26, AG26:AI26, G44:I44,
and
AG44:AI44. I have an Auto_Open sub in place to open
the
workbook on this "Scorecard" worksheet. These four
cells
are weighting factors and the numbers, formatted
percent,
must equal 100%. Also, there must be a number entry in
each of the four cells, even if it is zero. If the
user
does not make an entry (blank cell) a message must
come
up
saying "Weight for cell *** is required." If they
leave
multiple cells blank, the message would include those
cells as well. Users cannot leave the worksheet until
all
four cells are populated.

What would the code be? Would I put the code in the
worksheet code object, or in Module 1?



.

.

Bob, need your e-mail address

Bob Phillips wrote:
*Phil,

Is this with the original or revised version? Although both should be
okay,
I have tried them both with and without merged cells.

Want to send me the workbook to look at (do the usual with the email
address)

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Phil Hageman" wrote in
message
...
Bob, I receive a compile error: Type Mismatch,

Public Function ValidScorecard() As Boolean
Dim sMsg As String
ValidScorecard = True
sMsg = sMsg & CheckRange("G26")
"G26" is highlighted


-----Original Message-----
Bob, Thanks for your reply - you're right, I am stepping
into the deep end. A request: I now have an additional
requirement that not only must the cells be populated,
the
values entered must be greater than zero. Could you add
that feature into the code? Thanks, Phil
-----Original Message-----
Phil,

Are you ready for this?

This code goes in a normal code module, Module 1


'--------------------------------------------------------
-
------------------
Public Function ValidScorecard() As Boolean
Dim sMsg As String

ValidScorecard = True

sMsg = sMsg & CheckRange("G26")

sMsg = sMsg & CheckRange("AG26")

sMsg = sMsg & CheckRange("G44")

sMsg = sMsg & CheckRange("AG44")

If Len(sMsg) 0 Then
MsgBox sMsg
ValidScorecard = False
End If

End Function

Private Function CheckRange(cell As String)
Dim sMsg As String

With Worksheets("Scorecard")
If IsEmpty(.Range(cell)) Then
If .Range(cell).MergeArea.Address(False,
False) < cell Then
sMsg = "Weight for cell(s) " & _
.Range(cell).MergeArea.Address &
_
" is required"
Else
sMsg = "Weight for cell " & _
.Range(cell).Address & _
" is required"
End If
CheckRange = sMsg & vbCrLf
End If
End With

End Function


'--------------------------------------------------------
-
------------------


This following code goes in the Scorecard worksheet code
module



'--------------------------------------------------------
-
------------------
Private Sub Worksheet_Deactivate()

If Not ValidScorecard Then
Worksheets("Scorecard").Activate
End If
End Sub


'--------------------------------------------------------
-
------------------

and finally, this goes in the ThisWorkbook code m odule



'--------------------------------------------------------
-
------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If ActiveSheet.Name = "Scorecard" Then
If Not ValidScorecard Then
Cancel = True
Worksheets("Scorecard").Activate
End If
End If
End Sub


'--------------------------------------------------------
-
------------------

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Phil Hageman"
wrote in message
...
There are four cells (merged cell ranges) I want users
to
fill data into before leaving the worksheet (worksheet
name is "Scorecard"); G26:I26, AG26:AI26, G44:I44,
and
AG44:AI44. I have an Auto_Open sub in place to open
the
workbook on this "Scorecard" worksheet. These four
cells
are weighting factors and the numbers, formatted
percent,
must equal 100%. Also, there must be a number entry in
each of the four cells, even if it is zero. If the
user
does not make an entry (blank cell) a message must
come
up
saying "Weight for cell *** is required." If they
leave
multiple cells blank, the message would include those
cells as well. Users cannot leave the worksheet until
all
four cells are populated.

What would the code be? Would I put the code in the
worksheet code object, or in Module 1?



.

.
*


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

bob . phillips @ tiscali . co . uk

remove the spaces

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"pjhageman " wrote in message
...
Bob, need your e-mail address

Bob Phillips wrote:
*Phil,

Is this with the original or revised version? Although both should be
okay,
I have tried them both with and without merged cells.

Want to send me the workbook to look at (do the usual with the email
address)

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Phil Hageman" wrote in
message
...
Bob, I receive a compile error: Type Mismatch,

Public Function ValidScorecard() As Boolean
Dim sMsg As String
ValidScorecard = True
sMsg = sMsg & CheckRange("G26")
"G26" is highlighted


-----Original Message-----
Bob, Thanks for your reply - you're right, I am stepping
into the deep end. A request: I now have an additional
requirement that not only must the cells be populated,
the
values entered must be greater than zero. Could you add
that feature into the code? Thanks, Phil
-----Original Message-----
Phil,

Are you ready for this?

This code goes in a normal code module, Module 1


'--------------------------------------------------------
-
------------------
Public Function ValidScorecard() As Boolean
Dim sMsg As String

ValidScorecard = True

sMsg = sMsg & CheckRange("G26")

sMsg = sMsg & CheckRange("AG26")

sMsg = sMsg & CheckRange("G44")

sMsg = sMsg & CheckRange("AG44")

If Len(sMsg) 0 Then
MsgBox sMsg
ValidScorecard = False
End If

End Function

Private Function CheckRange(cell As String)
Dim sMsg As String

With Worksheets("Scorecard")
If IsEmpty(.Range(cell)) Then
If .Range(cell).MergeArea.Address(False,
False) < cell Then
sMsg = "Weight for cell(s) " & _
.Range(cell).MergeArea.Address &
_
" is required"
Else
sMsg = "Weight for cell " & _
.Range(cell).Address & _
" is required"
End If
CheckRange = sMsg & vbCrLf
End If
End With

End Function


'--------------------------------------------------------
-
------------------


This following code goes in the Scorecard worksheet code
module



'--------------------------------------------------------
-
------------------
Private Sub Worksheet_Deactivate()

If Not ValidScorecard Then
Worksheets("Scorecard").Activate
End If
End Sub


'--------------------------------------------------------
-
------------------

and finally, this goes in the ThisWorkbook code m odule



'--------------------------------------------------------
-
------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If ActiveSheet.Name = "Scorecard" Then
If Not ValidScorecard Then
Cancel = True
Worksheets("Scorecard").Activate
End If
End If
End Sub


'--------------------------------------------------------
-
------------------

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Phil Hageman"
wrote in message
...
There are four cells (merged cell ranges) I want users
to
fill data into before leaving the worksheet (worksheet
name is "Scorecard"); G26:I26, AG26:AI26, G44:I44,
and
AG44:AI44. I have an Auto_Open sub in place to open
the
workbook on this "Scorecard" worksheet. These four
cells
are weighting factors and the numbers, formatted
percent,
must equal 100%. Also, there must be a number entry in
each of the four cells, even if it is zero. If the
user
does not make an entry (blank cell) a message must
come
up
saying "Weight for cell *** is required." If they
leave
multiple cells blank, the message would include those
cells as well. Users cannot leave the worksheet until
all
four cells are populated.

What would the code be? Would I put the code in the
worksheet code object, or in Module 1?



.

.
*


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