Help Creating VBA Please - Linking Colour via Name in Sheet 1 to Sheet 2

HelpPls21NZ

New Member
Joined
Jan 18, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
Hi,

I need some help please.

I have Sheet 1, which is a colour index sheet.
Column A - Colour Name
Column E - RGB Colour
Column G - R Value
Column H - G Value
Column I - B Value

I found a VBA formula online and managed to get the colour to show in Column E.

Now, I have Sheet 2.
Which contains Colour Combos.

Column A - Colour Name
Column B - Combo 1A
Column C - Combo 1B
Column D - Combo 2A
Column E - Combo 2B
Column F - Combo 3A
Column G - Combo 3B

What I'd like to be able to do - Find a macro that can do this

1. Find the name on Sheet 1.
2. Get the associated colour ie Column E
3. Recognise the colour names in the columns of Sheet 2.
4. Replace the background with the associated colour
5. Font to be black or white depending on how dark the background colour is

I don't know how to code so thus have to ask for help here.

I have attached screenshots.
Could you help?

Any assistance is much appreciated.

Thank you
 

Attachments

  • Screen Shot 2021-01-19 at 12.32.43 PM.png
    Screen Shot 2021-01-19 at 12.32.43 PM.png
    40.4 KB · Views: 8
  • Screen Shot 2021-01-19 at 12.13.41 PM.png
    Screen Shot 2021-01-19 at 12.13.41 PM.png
    45.3 KB · Views: 8

Some videos you may like

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,498
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to MrExcel.
How about
VBA Code:
Sub HelpPls()
   Dim Cl As Range
   Dim Dic As Object
   
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         Dic(Cl.Value) = Cl.Offset(, 4).Interior.Color
      Next Cl
   End With
   With Sheets("Sheet2")
      For Each Cl In .Range("A2:G" & .Range("A" & Rows.Count).End(xlUp).Row)
         If Dic.Exists(Cl.Value) Then
            Cl.Interior.Color = Dic(Cl.Value)
            Cl.Font.Color = TextColorToUse(Cl.Interior.Color)
         End If
      Next Cl
   End With
End Sub
Function TextColorToUse(BackColor As Long) As Long

'  This function returns the color to use for
'  text to make it readable on a dark background
'  Code by Rick Rothstein
  Dim Luminance As Long
  Luminance = 77 * (BackColor Mod &H100) + _
              151 * ((BackColor \ &H100) Mod &H100) + _
              28 * ((BackColor \ &H10000) Mod &H100)
  '  Default value of TextColorToUse is 0-Black, set
  '  it to White if the Luminance is less than 32640
  If Luminance < 32640 Then TextColorToUse = vbWhite
End Function
 

HelpPls21NZ

New Member
Joined
Jan 18, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to MrExcel.
How about
VBA Code:
Sub HelpPls()
   Dim Cl As Range
   Dim Dic As Object
  
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Sheet1")
      For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
         Dic(Cl.Value) = Cl.Offset(, 4).Interior.Color
      Next Cl
   End With
   With Sheets("Sheet2")
      For Each Cl In .Range("A2:G" & .Range("A" & Rows.Count).End(xlUp).Row)
         If Dic.Exists(Cl.Value) Then
            Cl.Interior.Color = Dic(Cl.Value)
            Cl.Font.Color = TextColorToUse(Cl.Interior.Color)
         End If
      Next Cl
   End With
End Sub
Function TextColorToUse(BackColor As Long) As Long

'  This function returns the color to use for
'  text to make it readable on a dark background
'  Code by Rick Rothstein
  Dim Luminance As Long
  Luminance = 77 * (BackColor Mod &H100) + _
              151 * ((BackColor \ &H100) Mod &H100) + _
              28 * ((BackColor \ &H10000) Mod &H100)
  '  Default value of TextColorToUse is 0-Black, set
  '  it to White if the Luminance is less than 32640
  If Luminance < 32640 Then TextColorToUse = vbWhite
End Function
Thank you for your swift reply. :)

I added that code to Sheet2 but nothing happens.
Should I add it to Sheet1 instead?

Sorry.. but total noob here.
Coding is way beyond my scope :P

Thanks
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,498
Office Version
  1. 365
Platform
  1. Windows
You need to put it in a standard module, rather than a sheet module & you run it by using Alt F8, select the macro & click "Run", or you can assign it to a button.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,484
Messages
5,625,034
Members
416,064
Latest member
meiravmeron

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