Conditional formatting (or VBA) to add same background colour as condition formatting in another cell

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
2,865
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
Hi Everyone,
I have conditional formatting in Column J (range J30:J130) using the Colour Series formatting giving me a colour heat map red to green
the annoying part is i cant get it to colour the rest of the lines (range H30:I130)

so what i need is a way for vba or more conditional formatting to colour the rows in (range H30:I130) the same as is next to them in J

Anyone know if this is possible and how to do it? (happy to change what i'm currently doing if need to)


Thanks

Tony
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,988
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Sub VBColourScales()
   Dim Cl As Range, Rng As Range
   Dim Mn As Long, Mx As Long, Av As Long
   Dim LowClr As Variant, MidClr As Variant, HighClr As Variant
   
   'green (low) to red (high) colour scale
   LowClr = Array(99, 190, 123)     'Green
   MidClr = Array(255, 235, 132)    'Yellow
   HighClr = Array(248, 107, 107)   'Red
   
   Set Rng = Range("J30:J130")
   
   Mn = Application.Min(Rng)
   Mx = Application.Max(Rng)
   Av = Application.Percentile(Rng, 0.5)
   
   For Each Cl In Rng
      If Cl <= Av Then
         Cl.Offset(, -2).Resize(, 3).Interior.Color = GetColour(LowClr, MidClr, (Cl - Mn), (Av - Mn))
      Else
         Cl.Offset(, -2).Resize(, 3).Interior.Color = GetColour(HighClr, MidClr, (Cl - Mx), (Av - Mx))
      End If
   Next Cl
End Sub
Function GetColour(BaseClr As Variant, MidClr As Variant, Dif As Long, Avg As Long) As Long
   Dim i As Long
   Dim Clr As Double
   
   For i = 0 To 2
      Clr = (MidClr(i) - BaseClr(i)) / Avg
      GetColour = GetColour + Int((Dif * Clr + BaseClr(i))) * 256 ^ i
   Next i
End Function
 
Solution

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
2,865
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
Excellent,
Thank you fluff,
This will do nicely :)
Tony
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,988
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback
 

Forum statistics

Threads
1,144,366
Messages
5,723,942
Members
422,527
Latest member
TotalBeginner201

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