Forum Discussion

chowell97's avatar
chowell97
Copper Contributor
Mar 10, 2023
Solved

If certain excel table cells are red, value =1

Hello,   I have an excel table that is currently 20 columns, B to U, but this number could increase. Using conditional formatting rules, certain cells within a row will be either red or no color. ...
  • HansVogelaar's avatar
    HansVogelaar
    Mar 11, 2023

    chowell97 

    Try this:

    'Changes color of sheet tab according to SAM selection
    Private Sub Worksheet_Change(ByVal Target As Range)
        If ActiveSheet.ListObjects(2).DataBodyRange(1, 4).Value > 0 Then
            Select Case Target.Value
                Case "Chris"
                    Me.Tab.Color = vbRed
                Case "Jerry"
                    Me.Tab.Color = vbGreen
                Case "John"
                    Me.Tab.Color = vbBlue
                Case "Mike"
                    Me.Tab.Color = vbYellow
            End Select
        End If
    
        'Adds version and license flag
        ActiveSheet.Unprotect "1"
        Application.EnableEvents = False
        Dim Tbl As ListObject
        Dim TblRow As ListRow
        Dim KIndex As Long
        Dim XIndex As Long
        Dim VFIndex As Long
        Dim EIndex As Long
        Dim SIndex As Long
        Dim LFIndex As Long
        Dim c As Long
        Dim f As Boolean
        Set Tbl = Me.ListObjects(1)
        KIndex = Tbl.ListColumns("KLINOS").Index
        XIndex = Tbl.ListColumns("XJET VERSION").Index
        VFIndex = Tbl.ListColumns("VERSION FLAG").Index
        EIndex = Tbl.ListColumns("ER LICENSE").Index
        SIndex = Tbl.ListColumns("SL LICENSE").Index
        LFIndex = Tbl.ListColumns("LICENSE FLAG").Index
        For Each TblRow In Tbl.ListRows
            If Not Intersect(TblRow.Range, Target) Is Nothing Then
                f = False
                For c = KIndex To XIndex
                    If TblRow.Range(1, c).DisplayFormat.Interior.Color = vbRed Then
                        f = True
                        Exit For
                    End If
                Next c
                TblRow.Range(1, VFIndex).Value = -f
                f = False
                For c = EIndex To SIndex
                    If TblRow.Range(1, c).DisplayFormat.Interior.Color = vbRed Then
                        f = True
                        Exit For
                    End If
                Next c
                TblRow.Range(1, LFIndex).Value = -f
            End If
        Next TblRow
        Application.EnableEvents = True
        ActiveSheet.Protect "1"
    End Sub

Resources