Prevent users to leave blank cells before leaving the worksheet

[maytey]

Managed to get the following script from this forum.
However, i need to validate a list of different cells, instead of 1 cell. I tried to specify the range by rngCheck = wsCheck.Range("A1":"A13"). But it does not seem to work at all.

Can someone please help? Thank you so much!!

[VBA]Option Explicit

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
'Macro created 07/06/2005 21:29 by Ken Puls
'Macro Purpose: Force a user to enter a value in Range A1
' on Sheet1 before leaving the sheet

Dim wsCheck As Worksheet
Dim rngCheck As Range

'Set the ranges you want to check here
Set wsCheck = Worksheets("Sheet1")
Set rngCheck = wsCheck.Range("A1")

'Turn off events to avoid triggering a loop
Application.EnableEvents = False

'Check if user is leaving Sheet1
If Sh.Name = wsCheck.Name Then

'Check if Range A1 is empty
If IsEmpty(rngCheck) Then
'If so, reactivate the sheet, select the cell, and
'tell user they must enter a value
wsCheck.Activate
rngCheck.Select
MsgBox "Sorry, you must enter a value in " & rngCheck.Address
End If
End If

'Restore events
Application.EnableEvents = True
End Sub[/VBA]

[shamsam1]

try this

rngCheck = wsCheck.Range("A1:A13")

regards
sam

[maytey]

Hi Sam,

Can't work as well. Even when i key in A1, the error message do not appear at all.

By the way, can i ask how can i prevent the user from saving the file if some of the validation rules are not met.

For example, if some of the cells are left blank or some of the numbers have failed the data validation.

Thanks for your help!

[david000]

[VBA]Private Sub Worksheet_Deactivate()
Dim rngCheck As Range
Dim cel As Range
Dim j As String
Dim i As Integer




Set rngCheck = Me.Range("A1:A13")



i = 0
For Each cel In rngCheck
If IsEmpty(cel) Then
i = i + 1
j = j & cel.Address & vbNewLine
End If
Next cel

If i = 0 Then Exit Sub


Me.Activate
MsgBox "Sorry, you must enter a value in: " & vbNewLine & j
End Sub
[/VBA]

[maytey]

Thank you so much David!

The script works! But i just realised that i will only need to prompt the user to fill in the blank cells if a certain cell on the same row is being filled in. Let me illustrate further:

Cell A1 = Asset Class
Cell B1 = Project Name

I need to write a script to check that, if A1 is a non-blank (meaning it is being filled up), then B1 cannot be a blank cell. However, my A1 cell has a drop down list (using data validation).

Do you think you can help??

Thank you so much!!

[david000]

[VBA]Private Sub Worksheet_Deactivate()
Dim rngCheck As Range
Dim cel As Range
Dim j As String
Dim i As Integer


Set rngCheck = Me.Range("A1:A13")


i = 0
For Each cel In rngCheck
If Not IsEmpty(cel) And IsEmpty(cel.Offset(, 1)) Then
i = i + 1
j = j & ">" & cel.Offset(, 1).Address & vbNewLine
End If
Next cel

If i = 0 Then Exit Sub


Me.Activate
MsgBox "Sorry, you must enter a value in: " & vbNewLine & j
End Sub

[/VBA]

[maytey]

Thanks David!! The script works perfectly fine!
You have been a great help.

Out of curiousity, is there a function whereby it will prevent the user from saving the file if they fail the validation test?

[david000]

Yes, that is possible, but validation set up correctly should not fail --- it's the purpose of that feature to begin with.


This line can be used to prevent a save. If something fails to meet a test.
[VBA]ActiveWorkbook.Close SaveChanges:=False[/VBA]

[maytey]

Thanks David! You have been a great help!

[maytey]

Yes, that is possible, but validation set up correctly should not fail --- it's the purpose of that feature to begin with.


This line can be used to prevent a save. If something fails to meet a test.
[VBA]ActiveWorkbook.Close SaveChanges:=False[/VBA]

Hi David, i need to amend the macros again. i will need to validate 2 columns instead of one. How do i amend this?

For example:
If column A is non-blank, column B and column C must be filled in.

Thanks for your help!!

[david000]

[vba]Option Explicit
Private Sub Worksheet_Deactivate()
Dim rngCheck As Range
Dim cel As Range
Dim j As String
Dim i As Integer

Set rngCheck = Me.Range("a1:c13")
i = 0
For Each cel In rngCheck
If Not IsEmpty(cel) Then
i = i + 1
End If
Next cel

If i = 0 Then Exit Sub

On Error GoTo xit:

If i <> 0 Then
For Each cel In rngCheck.SpecialCells(xlCellTypeBlanks)
j = j & "please fill in >>>" & vbTab & cel.Address & vbNewLine
Next cel
End If

Me.Activate
MsgBox "Sorry, you must enter a value in: " & vbNewLine & j

xit:
Exit Sub
End Sub


[/vba]

[maytey]

[vba]Option Explicit
Private Sub Worksheet_Deactivate()
Dim rngCheck As Range
Dim cel As Range
Dim j As String
Dim i As Integer

Set rngCheck = Me.Range("a1:c13")
i = 0
For Each cel In rngCheck
If Not IsEmpty(cel) Then
i = i + 1
End If
Next cel

If i = 0 Then Exit Sub

On Error GoTo xit:

If i <> 0 Then
For Each cel In rngCheck.SpecialCells(xlCellTypeBlanks)
j = j & "please fill in >>>" & vbTab & cel.Address & vbNewLine
Next cel
End If

Me.Activate
MsgBox "Sorry, you must enter a value in: " & vbNewLine & j

xit:
Exit Sub
End Sub


[/vba]

Hi David,

Still can't work. I have attached the file for your reference. i need to validate the yellow coloured cells under column G and H.. Meaning, if column E is non blank, column G and H must be filled in.

Thanks for your help!!

[david000]

Uhg! That changes things quite a bit!

I'm going with the impression that we are only checking every 6th row?
And I had to fix the spacing to match a check for every 6th row.

It works in the attachment. For your original you'll have to insure that the rows of data between 10 and 123 are 6 apart that's all.


[VBA]Private Sub Worksheet_Deactivate()
Dim i, c As Integer
Dim lastrow As Long
Dim msg, msg2 As String

lastrow = 123

For i = 10 To 123 Step 6

With Me.Range("E" & i)

If Not IsEmpty(.Value) Then
c = c + 1
If c = 0 Then Exit Sub
If c <> 0 And .Offset(, 2) = "" Then
msg = msg & "In column ""G""" & vbTab & .Offset(, 2).Address & vbNewLine
End If
If c <> 0 And .Offset(, 3) = "" Then
msg2 = msg2 & "In column ""H""" & vbTab & .Offset(, 3).Address & vbNewLine
End If
End If

End With
Next i
Me.Activate
MsgBox "Please fill in these cells:" & vbNewLine & msg & msg2
End Sub
[/VBA]

[maytey]

thanks David!! You ae such a gem!

[maytey]

Hi David.. seems like if i have filled everything in, the warning " Please fill in the cells still pops up.. but with no indication which cell is missing..

[maytey]

Hi David,

So sorry.. can i bother you to look at this macro which i inherit from another user.. i seem to have problem with the paste special values.. can you help???

After clicking on the copy data, it will prompt a msg saying.. there is a large amount of information on the clipboard. Click yes to save the information and no to clear the clipboard... no matter which selection i made, the macro does not seem to paste my worksheets..

However, if i use the paste all function, it works perfectly fine...

Can you help?

Thanks....

[david000]

Ok, sorry about that last post, this should work. According to my last post (every 6 lines exactly).

So, drop it in that last test book I unloaded so I don't have to upload another one, please.

[VBA]
Private Sub Worksheet_Deactivate()
Dim i, c, j As Integer
Dim msg As String
Dim cel As Range
c = 0: j = 0

For i = 10 To 124 Step 6
For Each cel In Me.Range("E" & i)



If cel.Value <> "" And cel.Offset(, 2) = "" Then
msg = msg & "In column ""G""" & vbTab & cel.Offset(, 2).Address & vbNewLine
c = c + 1
End If

If cel.Value <> "" And cel.Offset(, 3) = "" Then
msg = msg & "In column ""H""" & vbTab & cel.Offset(, 3).Address & vbNewLine
j = j + 1
End If



Next cel
Next i

If c = 0 And j = 0 Then
Exit Sub
Else
Me.Activate
MsgBox "Please fill in these cells: " & vbNewLine & msg
End If
End Sub
[/VBA]