Auditing Excel sheet - Message Box on exiting excel

[test]

Greetings,

I am new to programming in excel. I have a requirement where a excel
needs to be audited for certain tasks. This is what I need to achieve

Requirement:

"Column A in excel1 can only have one of the 3 statuses: FAIL, OTHER
or SUCCESS.
If Column A is filled with either FAIL or OTHER status value, then
Column B should never be kept empty. It means that Column B should
always have a value and that respective cell should never be left
empty. Also, Column A cannot have any other status except the above 3"

Work done till now: I have already implemented the functionality where
if the Column B is left blank, the respective cell gets highlighted
letting user know that he needs to fill in that cell. However,
sometimes user might ignore and might try to save and close excel
without fully confirming to above requirement.

Main Objective: To come up with a code in excel that will display a
mesasge box to user (when he tries to save and exit the excel) letting
him know if the above main Requirement gets violated.

Can anyone please help me here.

TIA

 

[Mike H]

Hi,

Try this . ALT+F11 to open vb editor, double click 'ThisWorkbook' and paste
the code below in. Change MySheet to the name of your data sheet. Before a
save it checks that only your legal values are in column A and if column A is
legal then column B must be populated.

I don't see how checking this before close helps (it can be done) but if you
don't allow an illegal save then an illegal close isn't possible.


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim MySheet As String, lastrow As Long
MySheet = "Sheet1"
lastrow = Sheets(MySheet).Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = Sheets(MySheet).Range("A1:A" & lastrow)
For Each c In MyRange
Select Case UCase(c)
Case "FAIL", "OTHER", "SUCCESS"
If c.Offset(, 1).Value = "" Then
MsgBox "You must populate " & c.Offset(, 1).Address
Cancel = True
Exit For
End If
Case Else
MsgBox "Illegal value in " & c.Address
Cancel = True
Exit For
End Select
Next
End Sub

Mike

 

[Matt Richardson]

Greetings,

I am new to programming in excel. I have a requirement where a excel
needs to be audited for certain tasks. This is what I need to achieve

Requirement:

"Column A in excel1 can only have one of the 3 statuses: FAIL, OTHER
or SUCCESS.
If Column A is filled with either FAIL or OTHER status value, then
Column B should never be kept empty. It means that Column B should
always have a value and that respective cell should never be left
empty. Also, Column A cannot have any other status except the above 3"

Work done till now: I have already implemented the functionality where
if the Column B is left blank, the respective cell gets highlighted
letting user know that he needs to fill in that cell. However,
sometimes user might ignore and might try to save and close excel
without fully confirming to above requirement.

Main Objective: To come up with a code in excel that will display a
mesasge box to user (when he tries to save and exit the excel) letting
him know if the above main Requirement gets violated.

Can anyone please help me here.

TIA

Hi there.

You can try this bit of code in Excel. Click Alt+F11 to bring up the
code window and place it in the Worksheet module:-

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim x As Integer

For Each cell In Range("A:A")

If LCase(cell.Value) = "other" Or LCase(cell.Value) = "fail" Then
If Cells(cell.Row, cell.Column + 1).Value = "" Then
x = x + 1
End If
End If

Next

If x > 0 Then
MsgBox "You must fill in all blanks"
cancel = true
End If

End Sub

And I think that should do it. It's a quick and dirty fix but it will
check for blanks and then alert the user that there are blanks before
the sheet can be closed. Hope this helps.

BW
Matthew Richardson
http://teachr.blogspot.com

 

[Mike H]

I forgt to include a test for empty cells in column a

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim MySheet As String, lastrow As Long
MySheet = "Sheet1"
lastrow = Sheets(MySheet).Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = Sheets(MySheet).Range("A1:A" & lastrow)
For Each c In MyRange
Select Case UCase(c)
Case "FAIL", "OTHER", "SUCCESS"
If c.Offset(, 1).Value = "" Then
MsgBox "You must populate " & c.Offset(, 1).Address
Cancel = True
Exit For
End If
Case Else
If c.Value <> "" Then
MsgBox "Illegal value in " & c.Address
Cancel = True
Exit For
End If
End Select
Next
End Sub


Mike

 

[test]

I forgt to include a test for empty cells in column a

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim MySheet As String, lastrow As Long
MySheet = "Sheet1"
lastrow = Sheets(MySheet).Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = Sheets(MySheet).Range("A1:A" & lastrow)
For Each c In MyRange
    Select Case UCase(c)
        Case "FAIL", "OTHER", "SUCCESS"
        If c.Offset(, 1).Value = "" Then
            MsgBox "You must populate " & c.Offset(, 1).Address
            Cancel = True
            Exit For
        End If
         Case Else
            If c.Value <> "" Then
            MsgBox "Illegal value in " & c.Address
            Cancel = True
            Exit For
            End If
    End Select
Next
End Sub

Mike








- Show quoted text -

Thanks Matt/Mike. Its working as expected.