Refresh button to reconcile sheet names based on cell values and adjacent column text

[rdoulaghsingh]

Hello! I'm trying to create a function which will be assigned as a macro to a "Refresh" button which will read values from D3:D59 and color the tabs based on associated cell value based on matching string text in Column B. For example: It would read the names of all tabs that match with their corresponding names in Column B from B3:B59, taking into consideration a status of "Not Started", "In Progress" or "Completed" from the D column.

1)If the cells in D column contain "Not Started", the tab with matching names from Column B would change to red.
2)If the cells in D column contain "In Progress", the tab with matching names from Column B would change to yellow.
3)If the cells in D column contain "Completed", the tab with matching name from Column B would change to green.

The reason I'm trying to implement this is in the even a user decides to copy a status and paste it down the list. If they copy and paste, it doesn't update the sheet/tab colors, but if I do the above through a refresh button, that could work. Any help would be greatly appreciated. Thanks!

 

[Trebor76]

Hi rdoulaghsingh,

Try this:

Option Explicit
Sub Macro1()

    Dim strHEXcolor As String, strRGBcolor As String
    Dim intRed As Integer, intGreen As Integer, intBlue As Integer
    Dim ws As Worksheet
    Dim lngMyRow As Long, lngLastRow As Long
    
    'Code for cell RGB was adapted from here: _
    https://www.thespreadsheetguru.com/the-code-vault/2014/11/5/retrieve-excel-cells-font-fill-rgb-color-code
    
    Application.ScreenUpdating = False
    
    lngLastRow = Range("A:D").Find("*", , , , xlByRows, xlPrevious).Row
    
    For lngMyRow = 2 To lngLastRow
        On Error Resume Next
            Set ws = ThisWorkbook.Sheets(CStr(Range("A" & lngMyRow)))
            If Err.Number = 0 Then
                strHEXcolor = Right("000000" & Hex(Range("D" & lngMyRow).Interior.Color), 6)
                intRed = CInt("&H" & Right(strHEXcolor, 2)): intGreen = CInt("&H" & Mid(strHEXcolor, 3, 2)): intBlue = CInt("&H" & Left(strHEXcolor, 2))
                ws.Tab.Color = RGB(intRed, intGreen, intBlue)
            End If
        On Error GoTo 0
    Next lngMyRow
    
    Application.ScreenUpdating = True
    
End Sub

Hope that helps,

Robert

 

[Trebor76]

Ah, I see the sheet names are in Col. B:

Option Explicit
Sub Macro1()

    Dim strHEXcolor As String, strRGBcolor As String
    Dim intRed As Integer, intGreen As Integer, intBlue As Integer
    Dim ws As Worksheet
    Dim lngMyRow As Long, lngLastRow As Long
    
    'Code for cell RGB was adapted from here: _
    https://www.thespreadsheetguru.com/the-code-vault/2014/11/5/retrieve-excel-cells-font-fill-rgb-color-code
    
    Application.ScreenUpdating = False
    
    lngLastRow = Range("B:D").Find("*", , , , xlByRows, xlPrevious).Row
    
    For lngMyRow = 2 To lngLastRow
        On Error Resume Next
            Set ws = ThisWorkbook.Sheets(CStr(Range("B" & lngMyRow)))
            If Err.Number = 0 Then
                strHEXcolor = Right("000000" & Hex(Range("D" & lngMyRow).Interior.Color), 6)
                intRed = CInt("&H" & Right(strHEXcolor, 2)): intGreen = CInt("&H" & Mid(strHEXcolor, 3, 2)): intBlue = CInt("&H" & Left(strHEXcolor, 2))
                ws.Tab.Color = RGB(intRed, intGreen, intBlue)
            End If
        On Error GoTo 0
    Next lngMyRow
    
    Application.ScreenUpdating = True
    
End Sub

 

[rdoulaghsingh]

Ah, I see the sheet names are in Col. B:

Option Explicit
Sub Macro1()

    Dim strHEXcolor As String, strRGBcolor As String
    Dim intRed As Integer, intGreen As Integer, intBlue As Integer
    Dim ws As Worksheet
    Dim lngMyRow As Long, lngLastRow As Long
  
    'Code for cell RGB was adapted from here: _
    https://www.thespreadsheetguru.com/the-code-vault/2014/11/5/retrieve-excel-cells-font-fill-rgb-color-code
  
    Application.ScreenUpdating = False
  
    lngLastRow = Range("B:D").Find("*", , , , xlByRows, xlPrevious).Row
  
    For lngMyRow = 2 To lngLastRow
        On Error Resume Next
            Set ws = ThisWorkbook.Sheets(CStr(Range("B" & lngMyRow)))
            If Err.Number = 0 Then
                strHEXcolor = Right("000000" & Hex(Range("D" & lngMyRow).Interior.Color), 6)
                intRed = CInt("&H" & Right(strHEXcolor, 2)): intGreen = CInt("&H" & Mid(strHEXcolor, 3, 2)): intBlue = CInt("&H" & Left(strHEXcolor, 2))
                ws.Tab.Color = RGB(intRed, intGreen, intBlue)
            End If
        On Error GoTo 0
    Next lngMyRow
  
    Application.ScreenUpdating = True
  
End Sub

Thanks for your reply. It doesn't seem to work though. The second script you sent just changed all my tabs to "no color".

 

[Trebor76]

The fill color must be based on conditional formatting.

Try this where the cell fill colour can either have been done manually or via conditional formatting:

Option Explicit
Sub Macro1()

    Dim strHEXcolor As String, strRGBcolor As String
    Dim intRed As Integer, intGreen As Integer, intBlue As Integer
    Dim ws As Worksheet
    Dim lngMyRow As Long, lngLastRow As Long
   
    'Code for cell RGB was adapted from here: _
    https://www.thespreadsheetguru.com/the-code-vault/2014/11/5/retrieve-excel-cells-font-fill-rgb-color-code
   
    Application.ScreenUpdating = False
   
    lngLastRow = Range("B:D").Find("*", , , , xlByRows, xlPrevious).Row
   
    For lngMyRow = 2 To lngLastRow
        On Error Resume Next
            Set ws = ThisWorkbook.Sheets(CStr(Range("B" & lngMyRow)))
            If Err.Number = 0 Then
                If Range("D" & lngMyRow).FormatConditions.Count > 0 Then
                    strHEXcolor = Right("000000" & Hex(Range("D" & lngMyRow).DisplayFormat.Interior.Color), 6)
                Else
                    strHEXcolor = Right("000000" & Hex(Range("D" & lngMyRow).Interior.Color), 6)
                End If
                intRed = CInt("&H" & Right(strHEXcolor, 2)): intGreen = CInt("&H" & Mid(strHEXcolor, 3, 2)): intBlue = CInt("&H" & Left(strHEXcolor, 2))
                ws.Tab.Color = RGB(intRed, intGreen, intBlue)
            End If
        On Error GoTo 0
    Next lngMyRow
   
    Application.ScreenUpdating = True
   
End Sub

 

[rdoulaghsingh]

The fill color must be based on conditional formatting.

Try this where the cell fill colour can either have been done manually or via conditional formatting:

Option Explicit
Sub Macro1()

    Dim strHEXcolor As String, strRGBcolor As String
    Dim intRed As Integer, intGreen As Integer, intBlue As Integer
    Dim ws As Worksheet
    Dim lngMyRow As Long, lngLastRow As Long
  
    'Code for cell RGB was adapted from here: _
    https://www.thespreadsheetguru.com/the-code-vault/2014/11/5/retrieve-excel-cells-font-fill-rgb-color-code
  
    Application.ScreenUpdating = False
  
    lngLastRow = Range("B:D").Find("*", , , , xlByRows, xlPrevious).Row
  
    For lngMyRow = 2 To lngLastRow
        On Error Resume Next
            Set ws = ThisWorkbook.Sheets(CStr(Range("B" & lngMyRow)))
            If Err.Number = 0 Then
                If Range("D" & lngMyRow).FormatConditions.Count > 0 Then
                    strHEXcolor = Right("000000" & Hex(Range("D" & lngMyRow).DisplayFormat.Interior.Color), 6)
                Else
                    strHEXcolor = Right("000000" & Hex(Range("D" & lngMyRow).Interior.Color), 6)
                End If
                intRed = CInt("&H" & Right(strHEXcolor, 2)): intGreen = CInt("&H" & Mid(strHEXcolor, 3, 2)): intBlue = CInt("&H" & Left(strHEXcolor, 2))
                ws.Tab.Color = RGB(intRed, intGreen, intBlue)
            End If
        On Error GoTo 0
    Next lngMyRow
  
    Application.ScreenUpdating = True
  
End Sub

Works like magic! Thank you for taking the time to respond. Have a good night.

 

[Trebor76]

Works like magic! Thank you for taking the time to respond. Have a good night.

You're welcome.

 

[rdoulaghsingh]

You're welcome.

One quick question. Do you know what the color code or RGB code is for that shade of green in your code?

 

[rdoulaghsingh]

You're welcome.

Yours has a lighter shade of green with black writing and my original color has a darker shade with white writing. The color I'm using is 3962880. Do you know what color yours is?

 

[rdoulaghsingh]

Nevermind. Figured it out. Thanks!