VBA code to check if any one cell is colored in a range.

[mchilapur]

Dear all
I have put up the below code under 'ThisWorkbook' section and my intent is to check if a rectangle shape (its 13th) text is "YES" and if none of the cell in range "E36:E45" is colored (GREEN), then it must not allow user to move forward to next sheet..If atleast any one cell is colored, then it must not do anything(Must allow).

I dont know what mistake i am doing here...
Below code throws a message even if atleast one cell is colored.. (While it must do this if none of the cells are colored)

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)Dim Counter As Long
Dim Gcell As Range
Dim flg As Boolean
Counter = 0
If Sh.Shapes("Rectangle 13").TextFrame.Characters.Text = "YES" Then
For Each Gcell In Range("E36:E45")
        If Gcell.Interior.Color = 65280 Then Counter = Counter + 1
    Next
    If Counter = 0 Then
        Application.EnableEvents = False
        Sh.Activate
        Application.EnableEvents = True
        MsgBox "None of the cells are colored " & Sh.Name, vbExclamation, "Check of color cells"
    End If
  End If
End Sub

Please suggest.

 

[Jaafar Tribak]

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)Dim Counter As Long
Dim Gcell As Range
Dim flg As Boolean
Counter = 0
If Sh.Shapes("Rectangle 13").TextFrame.Characters.Text = "YES" Then
For Each Gcell In Range("E36:E45")
        If Gcell.Interior.Color = 65280 Then Counter = Counter + 1 [COLOR=#ff0000][B]: Exit Sub[/B][/COLOR]
    Next
    If Counter = 0 Then
        Application.EnableEvents = False
        Sh.Activate
        Application.EnableEvents = True
        MsgBox "None of the cells are colored " & Sh.Name, vbExclamation, "Check of color cells"
    End If
  End If
End Sub

 

[Jaafar Tribak]

Or maybe this:

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)Dim Counter As Long
    Dim Gcell As Range
    Dim flg As Boolean
    
    If Sh.Shapes("Rectangle 13").TextFrame.Characters.Text = "YES" Then
        For Each Gcell In Range("E36:E45")
            If Gcell.Interior.Color = 65280 Then Exit Sub
        Next
    End If
    Application.EnableEvents = False
    Sh.Activate
    Application.EnableEvents = True
    MsgBox "None of the cells are colored " & Sh.Name, vbExclamation, "Check of color cells"
End Sub

 

[mchilapur]

Doesn't seem to work...It still throws up the message..

 

[mikerickson]

How is the cell getting its color? From the user filling the cell or from Conditional Formatting?

 

[mchilapur]

cells are colored Using below code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const WS_RANGE As String = "E36:E45"


On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
  With Target
     If Selection.Interior.Color = 16777215 Then
     Selection.Interior.Color = 65280
Else
     Selection.Interior.Color = 16777215
     End If
  End With
End If


ws_exit:
Application.EnableEvents = True


End Sub