Forum Discussion
chowell97
Mar 10, 2023Copper Contributor
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. ...
- Mar 11, 2023
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
HansVogelaar
Mar 10, 2023MVP
Could you attach a small sample workbook demonstrating the problem (without sensitive data), or if that is not possible, make it available through OneDrive, Google Drive, Dropbox or similar?
- chowell97Mar 11, 2023Copper Contributor
I have attached the workbook.
There are notes on the Test sheet for the problems I tried to described.
Everything else within the workbook works as intended except for trying to add the version and license flag.
Thanks in advance
- HansVogelaarMar 11, 2023MVP
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
- chowell97Mar 12, 2023Copper ContributorThank you once again!
So far this has corrected my issue.