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

rdoulaghsingh

Board Regular
Joined
Feb 14, 2021
Messages
55
Office Version
  1. 365
Platform
  1. Windows
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!
 

Attachments

  • Dropdown.JPG
    Dropdown.JPG
    102.7 KB · Views: 3

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

Trebor76

Well-known Member
Joined
Jul 23, 2007
Messages
4,735
Hi rdoulaghsingh,

Try this:

VBA Code:
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

Well-known Member
Joined
Jul 23, 2007
Messages
4,735
Ah, I see the sheet names are in Col. B:

VBA Code:
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

Board Regular
Joined
Feb 14, 2021
Messages
55
Office Version
  1. 365
Platform
  1. Windows
Ah, I see the sheet names are in Col. B:

VBA Code:
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

Well-known Member
Joined
Jul 23, 2007
Messages
4,735

ADVERTISEMENT

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:

VBA Code:
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
 
Solution

rdoulaghsingh

Board Regular
Joined
Feb 14, 2021
Messages
55
Office Version
  1. 365
Platform
  1. Windows
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:

VBA Code:
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

Well-known Member
Joined
Jul 23, 2007
Messages
4,735

ADVERTISEMENT

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

You're welcome.
 

rdoulaghsingh

Board Regular
Joined
Feb 14, 2021
Messages
55
Office Version
  1. 365
Platform
  1. Windows
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?
 

Attachments

  • image_2021-02-20_225237.png
    image_2021-02-20_225237.png
    5 KB · Views: 1

Watch MrExcel Video

Forum statistics

Threads
1,129,508
Messages
5,636,733
Members
416,937
Latest member
crispix

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top