Force Cell entry based on specific condition

[JohnCollins]

Help Required please:

I have a tracker spread sheet whereby users are required to enter comments (text) when a specific RAG condition is met e.g.

If condition RAG <> "G" then user must enter a comment and the comment cannot be " " or blank.


Note: I have be able to apply a apply a simple cell conditional format to the cell, which changes the cell format to Red or Amber if the RAG status is "R" or "A", but as yet have not been able to find a way in which the user must enter a comment if RAG <> "G"?



Within my spreadsheet I have multiple worktabs (10 in total) with each tab representing a specific Business unit e.g. Sheet3 = Asset, Sheet4 = Premium etc ....

Within each sheet there are 30 row entries, commencing from L4 : L34, which requires that a comment is entered by the user if L4 <> “G”, whereby the comment cannot be blank or cell left empty.


Within each worksheet, the following cells can be found in exactly the same location (Row and Column) in each sheet whereby:
L4 = RAG Status (R,A,G)
N4 = User specific comments


The formula I have created below (should possibly work but being a novice I doubt it does) and only takes in to account one cell within the workbook, so, what would I need to do in order for it to:

1. Work for all 30 row entries on a Sheet.3 called Asset
   
2. Apply the formula to work over all remaining 10 sheets within the spreadsheet

Sub Comments()
Dim vVal

If (Sheet3.Range("L4" <> "G")) And IsEmpty(Sheet3.Range("N4")) Then

vVal = InputBox("Enter a Comment for N4")

If vVal = vbNullString Then Run "Comments"
End If
End Sub


-- removed inline image ---

 

[JohnCollins]

Peter,
I did a little more researching and found that this is a known feature within Excel which can only be resolved by using VB code. Note: Your code will only work if the user attempts edit the cell, if they do not edit the cell they can still save the sheet with blank entries in it. Thanks for your help though.

 

[pjmorris]

HI John,

True, but the conditional formating will at least highlight the issue.

An alternative approach to Calcux would be to use the Workbook_BeforeSave method, you would check the status of any cells that need comments and prevent saving unless all are correct (this could be REALLY annoying for users though!) Unfortunately I don't have time to develop this further so hopefully others may be able to help.
Have a good christmas break.

Regards

 

[MacroWriter]

You can loop over the sheets at the time of Save and prompt the user to enter the comments.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    'Place the code in Thisworkbook module
    'loop over all the sheets and check each sheet for validity.
    Dim errflag As Boolean
    Dim sh As Worksheet
    errflag = False
    For Each sh In ThisWorkbook
        Dim vVal
        If (sh.Range("L4" <> "G")) And IsEmpty(Trim(sh.Range("N4"))) Then
            errflag = True ' To trap if a sheet doesn't have comments
            sh.Range("N4").Interior.ColorIndex = 3
        End If
    Next
    If errflag = True Then
        MsgBox "Please fill the comments in the Highlighted", vbCritical
        'You can continue saving the workbook or not to by setting Cancel to False or True respectively
        Cancel = True
    Else
        Cancel = False
    End If
End Sub

 

[JohnCollins]

Peter, Thanks. However there appears to be a bug as Excel comes back with the following error message when attempting to save the code: "Run Time Error - 438" Object does not support this property or method?

 

[MacroWriter]

Please find the updated code. Place this in the Thisworkbook module.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    'Place the code in Thisworkbook module
    'loop over all the sheets and check each sheet for validity.
    Dim errflag As Boolean
    Dim sh As Worksheet
    errflag = False
    For Each sh In ThisWorkbook.Worksheets
        Dim vVal
        If (sh.Range("L4").Value <> "G") And Len(Trim(sh.Range("N4").Value)) = 0 Then
            errflag = True ' To trap if a sheet doesn't have comments
            sh.Range("N4").Interior.ColorIndex = 3
        End If
    Next
    If errflag = True Then
        MsgBox "Please fill the comments in the Highlighted", vbCritical
        'You can continue saving the workbook or not to by setting Cancel to False or True respectively
        Cancel = True
    Else
        Cancel = False
    End If
End Sub

 

[JohnCollins]

Thanks, but the excel now responds with the following error message: Runtime error 1004: Application-Defined or Object-Defined Error" relating to line 11 i.e "sh.Range("N4").Interior.ColourIndex = 3)". Any ideas as to what this Is?

 

[MacroWriter]

Please check whether the close braces as you mentioned in your code sh.Range("N4").Interior.ColourIndex = 3).As my code doesn't have it. If so, Please remove and try.

If everything is good and you find the error still. Please replace the line with the below code

sh.Range("N4").Interior.Color = RGB(255,0,0)

 

[JohnCollins]

Hi MacroWriter,

I have cut an pasted the new line of code, but still receive the same error message as per my previous posting, which does not have the bracket after the number 3! Note: If this line is omitted then the code appear to work.

Can the code be expanded so that it
A) Check the remaining lines on the active sheet i.e lines 5 to 50?
B) Is applied to specific worksheets within the workbook i.e. I have 5 sheets (A:E) but only sheets B,C,D are required to be checed. I assume that I should be able to specify the sheets I want to validate

 

[MacroWriter]

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    'Place the code in Thisworkbook module
    'loop over all the sheets and check each sheet for validity.
    Dim errflag, validate As Boolean
    Dim sh As Worksheet
    
    'Some values to configure
    '********************************************
    sheetsToBeValidated = "Sheet2; Sheet3" '<====Add and Seperate the sheet names to be validated using (;)semi colon
    startrow = 5 '<=Change the Starting row
    endrow = 50 '<=Change the End Row, If the Endrow is specified less than the starting row it would end up in error
    '*************************************
    
    errflag = False
    sheetsToBeValidated = Split(sheetsToBeValidated, ";")
    
    For Each sh In ThisWorkbook.Worksheets
        validate = False
        'To find the exceptional sheet names
        For i = 0 To UBound(sheetsToBeValidated) - 1
            If UCase(Trim(sh.Name)) = UCase(Trim(sheetsToBeValidated(i))) Then
                validate = True
                Exit For
            End If
        Next i
        
        If validate = True Then
          For rw = startrow To endrow
            If (sh.Range("L" & rw).Value <> "G") And Len(sh.Range("L" & rw).Value) <> 0 And Len(Trim(sh.Range("N" & rw).Value)) = 0 Then
                errflag = True ' To trap if a sheet doesn't have comments
'*****Remove this block of code if it errors********************************
                sh.Range("N" & rw).Interior.ColorIndex = 3
            Else
                sh.Range("N" & rw).Interior.ColorIndex = 0
'*************************************************************************
            
            
            End If
          Next rw
        End If
    Next
    If errflag = True Then
        MsgBox "Please fill the comments in the Highlighted", vbCritical
        'You can continue saving the workbook or not to by setting Cancel to False or True respectively
        Cancel = True
    Else
        Cancel = False
    End If
End Sub

Please check the code you need to specify the sheet names, Starting row and end row.

 

[JohnCollins]

Hi Macrowriter, Great bit of code which appears to work nearly. The issue I get, is that following the prompt the user goes back and enters an entry in to the cell, (thus a Red RAG and valid comment) however, when the user attempts to resave the code it fails to save and the message box keeps appearing.