Query on Conditional Formatting / Message Box

[Roopen]

Hi All,

Maybe a long shot but I might as well ask... is there a way of having a message box appear when someone closes my workbook with any conditional formats triggered to colour the cells in red..

For example if cell A1 is red due to conditional formatting being triggered can I remind the user to check it before they save/close?

Any help as always appreciated

 

[Andrew Poulsom]

Maybe this will help you:

http://www.cpearson.com/Excel/CFColors.htm

 

[Roopen]

Hi Andrew,

This is of help but doesn't quite give me the message box to alert the user that there is an error on the spreadsheet.

Is it possible to do this?

Thank you

Roopen

 

[Andrew Poulsom]

You would have to put some VBA code in the Workbook_BeforeClose (or BeforeSave)event procedure that counts the coloured cells and shows a message box if there are any.

 

[Roopen]

Really appreciate your response but please note that I am a complete novice and have no idea about VBA and have just started to copy and paste some codes found on here in my spreadsheets but cannot write VBA

Can you help or point me in the right direction?

Sorry

Roopen

 

[Andrew Poulsom]

Try this:

'    ThisWorkbook module
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim Sh As Worksheet
    Dim Cell As Range
    Set Sh = Worksheets("Sheet1")
    For Each Cell In Sh.Range("A1:A10")
        If ColorIndexOfCF(Cell) = 3 Then
            MsgBox "Please check cell " & Cell.Address(False, False)
            Cancel = True
            Exit Sub
        End If
    Next Cell
End Sub
 
'    General module
 
Function ColorIndexOfCF(Rng As Range, _
    Optional OfText As Boolean = False) As Integer
    Dim AC As Integer
    AC = ActiveCondition(Rng)
    If AC = 0 Then
        If OfText = True Then
           ColorIndexOfCF = Rng.Font.ColorIndex
        Else
           ColorIndexOfCF = Rng.Interior.ColorIndex
        End If
    Else
        If OfText = True Then
           ColorIndexOfCF = Rng.FormatConditions(AC).Font.ColorIndex
        Else
           ColorIndexOfCF = Rng.FormatConditions(AC).Interior.ColorIndex
        End If
    End If
End Function
 
Function ActiveCondition(Rng As Range) As Integer
    Dim Ndx As Long
    Dim FC As FormatCondition
    Dim Temp As Variant
    Dim Temp2 As Variant
    If Rng.FormatConditions.Count = 0 Then
        ActiveCondition = 0
    Else
        For Ndx = 1 To Rng.FormatConditions.Count
            Set FC = Rng.FormatConditions(Ndx)
            Select Case FC.Type
                Case xlCellValue
                Select Case FC.Operator
                    Case xlBetween
                        Temp = GetStrippedValue(FC.Formula1)
                        Temp2 = GetStrippedValue(FC.Formula2)
                        If IsNumeric(Temp) Then
                           If CDbl(Rng.Value) >= CDbl(FC.Formula1) And _
                               CDbl(Rng.Value) <= CDbl(FC.Formula2) Then
                               ActiveCondition = Ndx
                               Exit Function
                           End If
                       Else
                          If Rng.Value >= Temp And _
                             Rng.Value <= Temp2 Then
                             ActiveCondition = Ndx
                             Exit Function
                          End If
                       End If
                    Case xlGreater
                        Temp = GetStrippedValue(FC.Formula1)
                        If IsNumeric(Temp) Then
                           If CDbl(Rng.Value) > CDbl(FC.Formula1) Then
                              ActiveCondition = Ndx
                              Exit Function
                           End If
                        Else
                           If Rng.Value > Temp Then
                              ActiveCondition = Ndx
                              Exit Function
                           End If
                        End If
                    Case xlEqual
                        Temp = GetStrippedValue(FC.Formula1)
                        If IsNumeric(Temp) Then
                           If CDbl(Rng.Value) = CDbl(FC.Formula1) Then
                               ActiveCondition = Ndx
                               Exit Function
                           End If
                        Else
                           If Temp = Rng.Value Then
                              ActiveCondition = Ndx
                              Exit Function
                           End If
                        End If
                    Case xlGreaterEqual
                        Temp = GetStrippedValue(FC.Formula1)
                        If IsNumeric(Temp) Then
                           If CDbl(Rng.Value) >= CDbl(FC.Formula1) Then
                               ActiveCondition = Ndx
                               Exit Function
                           End If
                        Else
                           If Rng.Value >= Temp Then
                              ActiveCondition = Ndx
                              Exit Function
                           End If
                        End If
                    Case xlLess
                        Temp = GetStrippedValue(FC.Formula1)
                        If IsNumeric(Temp) Then
                            If CDbl(Rng.Value) < CDbl(FC.Formula1) Then
                               ActiveCondition = Ndx
                               Exit Function
                            End If
                        Else
                            If Rng.Value < Temp Then
                               ActiveCondition = Ndx
                               Exit Function
                            End If
                        End If
                    Case xlLessEqual
                        Temp = GetStrippedValue(FC.Formula1)
                        If IsNumeric(Temp) Then
                           If CDbl(Rng.Value) <= CDbl(FC.Formula1) Then
                              ActiveCondition = Ndx
                              Exit Function
                           End If
                        Else
                           If Rng.Value <= Temp Then
                              ActiveCondition = Ndx
                              Exit Function
                           End If
                        End If
                    Case xlNotEqual
                        Temp = GetStrippedValue(FC.Formula1)
                        If IsNumeric(Temp) Then
                           If CDbl(Rng.Value) <> CDbl(FC.Formula1) Then
                              ActiveCondition = Ndx
                              Exit Function
                           End If
                        Else
                           If Temp <> Rng.Value Then
                              ActiveCondition = Ndx
                              Exit Function
                           End If
                        End If
                    Case xlNotBetween
                        Temp = GetStrippedValue(FC.Formula1)
                        Temp2 = GetStrippedValue(FC.Formula2)
                        If IsNumeric(Temp) Then
                           If Not (CDbl(Rng.Value) <= CDbl(FC.Formula1)) And _
                              (CDbl(Rng.Value) >= CDbl(FC.Formula2)) Then
                              ActiveCondition = Ndx
                              Exit Function
                           End If
                        Else
                           If Not Rng.Value <= Temp And _
                              Rng.Value >= Temp2 Then
                              ActiveCondition = Ndx
                              Exit Function
                           End If
                        End If
                    Case Else
                        Debug.Print "UNKNOWN OPERATOR"
                End Select
            Case xlExpression
                If Application.Evaluate(FC.Formula1) Then
                   ActiveCondition = Ndx
                   Exit Function
                End If
            Case Else
                Debug.Print "UNKNOWN TYPE"
           End Select
        Next Ndx
    End If
    ActiveCondition = 0
End Function
 
Function GetStrippedValue(CF As String) As String
    Dim Temp As String
    If InStr(1, CF, "=", vbTextCompare) Then
       Temp = Mid(CF, 3, Len(CF) - 3)
       If Left(Temp, 1) = "=" Then
           Temp = Mid(Temp, 2)
       End If
    Else
       Temp = CF
    End If
    GetStrippedValue = Temp
End Function

 

[Roopen]

Andrew,

Thank you so much... I have cut and paste this in and for some reason the code doesnt seem to be doing anything at the moment (I have left some coditional formatting showing as errors)... I have pasted it in correctly and there are no errors appearing in the code so am a bit bemused... Have I done something wrong?

I really appreciate the time it would have taken you to do the coding and would like to see it work.

Roopen

 

[Andrew Poulsom]

Did you put the code in the correct places? The first procedure goes in the ThisWorkbook module. The remainder goes in a General module.

 

[Roopen]

Andrew,

Works a treat !!! Only got one question that you maybe able to help with...

Though the code is working great and identifies the cells with errors, why can I not close the spreadsheet if I do not want to clear them? I only wanted the message box as a warning to highlight the error...

Is there a way of modifying the code so it gives the option to continue closing or fix the error?

Its absolutely awesome and dread to think how long it took you to write this code.

Many thanks

 

[Andrew Poulsom]

Try this version of the BeforeClose event procedure:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim Sh As Worksheet
    Dim Cell As Range
    Dim Msg As String
    Dim Answer As VbMsgBoxResult
    Set Sh = Worksheets("Sheet1")
    For Each Cell In Sh.Range("A1:A10")
        If ColorIndexOfCF(Cell) = 3 Then
            Msg = "Please check cell " & Cell.Address(False, False) & vbCrLf
            Msg = Msg & "Click OK to close or Cancel to correct"
            Answer = MsgBox(Msg, vbInformation + vbOKCancel)
            If Answer = vbCancel Then
                Cancel = True
            End If
            Exit Sub
        End If
    Next Cell
End Sub