Apply Border Configurations To Specific Cell Background Colors

[miketurn]

(I figured this one would already exist, but when I do searches on the internet I get tons of results of people looking to change the color of border lines)

I was wondering if anyone has a macro that could analyze the active range of a spreadsheet and apply a specific border configuration to cells based on their specific background fill color.
I am looking for something that I can kind of tweak myself and learn a little bit in the process.

Basically I am looking for a macro that for example can take any cells that have a background fill color "ColorIndex = 36" (which is yellow) and add xlMedium thick border lines to the right and left sides.
As well as take any cells with a background fill color "ColorIndex = 34" (which is cyan) and add a xlMedium thick border around the entire cell.

I think with these two items I can tweak the macro to accomodate different colors and border configurations.

Thank you to anyone who reads this and has anything to share.

 

[Kenneth Hobson]

I guess it depends on which type of interior cell color you mean, conditional format or manually set?

Keep in mind that using colorindex as the criteria may not be the same for all users in their workbooks. I prefer using the Color property myself.

 

[miketurn]

@Kenneth Hobson
Thank you for your response, I am referring to color fills that are "manually set".
To be honest I have seen the "Conditional Formatting" within Excel, but have really overlooked this feature, your question has now brought it to my attention

Your other statement was something I was going to mention/ask as well, in the fact that I noticed that no one uses "ColorIndex" in their macros.
Kind of a bad habit that I developed from "recording" macros
You are correct, not the smartest idea, because I believe the "ColorIndex" refers to the color grid placement within Excel, if those swatch colors are changed in that grid, the new color will have the same "ColorIndex" value.

Initially I learned this when trying to find out why I couldn't get a simple light light pink fill color, which I was never able to achieve correctly.
https://www.mrexcel.com/forum/excel...kground-color-using-rgb-color-code-macro.html
If I changed the swatch color I was able to get a light light pink fill, but if I used the macro coding for RGB value, it never worked for that color. I was able to get it to work for other colors though.

Anyways, thank you for mentioning these items.

 

[Kenneth Hobson]

The fastest and easiest way is to find the formats that you want and then replace them. Once found, you don't have to replace with the same type. Record a macro to see the syntax for doing what you want. Then change the ReplaceFormat part to suit. e.g.

Sub frFormats()
  With Application
    .FindFormat.Clear
    .FindFormat.Interior.Color = vbYellow
    .ReplaceFormat.Clear
    .ReplaceFormat.Font.Color = vbRed
    
    ActiveSheet.UsedRange.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder _
          :=xlByColumns, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
          
    .FindFormat.Clear
    .ReplaceFormat.Clear
  End With
End Sub

 

[miketurn]

@Kenneth Hobson
Thank you for your response / macro.
Here are some things I was able to work on....

The following macro works, it successfully adds a border line to the right and left of all yellow filled cells

Sub BorderToYellowFill()
  With Application
    .FindFormat.Clear
    .FindFormat.Interior.Color = RGB(255, 255, 153)
    .ReplaceFormat.Borders(xlEdgeLeft).Weight = xlMedium
    .ReplaceFormat.Borders(xlEdgeRight).Weight = xlMedium
    
     ActiveSheet.UsedRange.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder _
          :=xlByColumns, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
     
    .FindFormat.Clear
    .ReplaceFormat.Clear
  End With
End Sub

I then tried adding the next desired feature which was adding a border around cells with red background fills...
I created one with trying to keep only one "With" command (SHOWN BELOW) and a different one with two "With" commands

Sub BorderToMultiColorFills()
  With Application
    .FindFormat.Clear
    .FindFormat.Interior.Color = RGB(255, 255, 153)
    .ReplaceFormat.Borders(xlEdgeLeft).Weight = xlMedium
    .ReplaceFormat.Borders(xlEdgeRight).Weight = xlMedium
    
    ActiveSheet.UsedRange.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByColumns, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True

    .FindFormat.Clear
    .FindFormat.Interior.Color = RGB(255, 0, 0)
    .ReplaceFormat.Borders(xlEdgeLeft).Weight = xlMedium
    .ReplaceFormat.Borders(xlEdgeRight).Weight = xlMedium
    .ReplaceFormat.Borders(xlEdgeTop).Weight = xlMedium
    .ReplaceFormat.Borders(xlEdgeBottom).Weight = xlMedium
'THINK I AM CORRECT THAT "BORDERAROUND" DOES NOT WORK IN THIS SITUATION?
    
    ActiveSheet.UsedRange.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByColumns, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
     
    .FindFormat.Clear
    .ReplaceFormat.Clear
  End With
End Sub

The two "Sub BorderToMultiColorFills" macros, both seem to work but produce a little strange activity.
When they are applied, you don't see the borders added right away, you either have to click on a different spreadsheet tab and then come back, or if I scroll down beyond the active sheet range and then scroll back up then I see the borders have been added. The spreadsheets were just simple spreadsheets tests, not large data filled sheets.

The one that adds just the border to the yellow, I think on occassion may have done this once or twice, but generally not, only when I added that second part.

I guess I could add some kind of refresh code to it but doesn't seem like this should be happening, for simple border adding.

Would someone be willing test my two "Sub BorderToMultiColorFills" and see if you experience similar results?
As mentioned the second attempt had two "With" commands.

If anyone has any advice on how to fix this, and or how to clean up my coding a bit, it would be greatly appreciated.
Thank You

 

[Kenneth Hobson]

It might be a bit cleaner to make a Main() to call two Find/Replace Format Subs.

No, the Range.BorderAround does not work in this method but can be used separately. While two Withs could be used, one is a bit cleaner. Maybe skip the With Application. With Application.ReplaceFormat might be the better choice.

I added a bit more to test and show how to set a few more options rather than relying on the defaults. The extras can be deleted. I could not replicate your refresh issue. An ActiveSheet.Calculate might be worth trying for you.

Test on blank ActiveSheet or even blank workbook.

Sub SetupAndTest_BorderToYellowFill()
  ActiveSheet.UsedRange.Clear
  [A1,B2,C3].Interior.Color = RGB(255, 255, 153)
  BorderToYellowFill
End Sub

Sub BorderToYellowFill()
  With Application
    .FindFormat.Clear
    .ReplaceFormat.Clear
    
    .FindFormat.Interior.Color = RGB(255, 255, 153)
    .ReplaceFormat.Borders(xlEdgeLeft).Weight = xlMedium
    .ReplaceFormat.Borders(xlEdgeRight).Weight = xlMedium
    
     ActiveSheet.UsedRange.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder _
          :=xlByColumns, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
     
    .FindFormat.Clear
    .ReplaceFormat.Clear
  End With
End Sub

Sub SetupAndTest_BorderToMultiColorFills()
  ActiveSheet.UsedRange.Clear
  [A1,B2,C3].Interior.Color = RGB(255, 255, 153)
  [E1:E3,F2,G3].Interior.Color = RGB(255, 0, 0)
  BorderToMultiColorFills
End Sub

Sub BorderToMultiColorFills()
  With Application
    .FindFormat.Clear
    With .ReplaceFormat
      .Clear
    
      Application.FindFormat.Interior.Color = RGB(255, 255, 153)
      .Borders(xlEdgeLeft).Weight = xlMedium
      .Borders(xlEdgeRight).Weight = xlMedium
    
      ActiveSheet.UsedRange.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder _
          :=xlByColumns, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True

      Application.FindFormat.Clear
      .Clear
      
      Application.FindFormat.Interior.Color = RGB(255, 0, 0)
      
      .Borders.LineStyle = xlContinuous
      .Borders.ColorIndex = xlAutomatic
      .Borders.TintAndShade = 0
      
      .Borders(xlEdgeLeft).Weight = xlMedium
      .Borders(xlEdgeRight).Weight = xlMedium
      .Borders(xlEdgeTop).Weight = xlMedium
      .Borders(xlEdgeBottom).Weight = xlMedium
  'THINK I AM CORRECT THAT "BORDERAROUND" DOES NOT WORK IN THIS SITUATION?
  'https://msdn.microsoft.com/en-us/vba/excel-vba/articles/range-borderaround-method-excel
  
      ActiveSheet.UsedRange.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder _
          :=xlByColumns, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
       
      Application.FindFormat.Clear
      .Clear
    End With
  End With
End Sub

 

[miketurn]

@Kenneth Hobson
Thank you again for your response and your continued help.
At first I will admit I was a little confused, but I think I understand what is going on now.

Here is the most up to date version at the moment, I have added a couple of questions / comments

Sub BorderToMultiColorFills()
  With Application
    .FindFormat.Clear
    With .ReplaceFormat
      .Clear     'IS THIS LINE CORRECT, JUST SEEMS OUT OF PLACE VISUALLY?
    
      Application.FindFormat.Interior.Color = RGB(255, 255, 153)
      .Borders(xlEdgeLeft).Weight = xlMedium
      .Borders(xlEdgeRight).Weight = xlMedium
    
      ActiveSheet.UsedRange.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder _
          :=xlByColumns, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True

      Application.FindFormat.Clear
      .Clear      'IS THIS LINE CORRECT, JUST SEEMS OUT OF PLACE VISUALLY?
      
      Application.FindFormat.Interior.Color = RGB(255, 0, 0)
      
      .Borders.LineStyle = xlContinuous
      .Borders.ColorIndex = xlAutomatic
      '.Borders.TintAndShade = 0        THIS LINE CAUSED A DEBUG DIALOG SO I OMITTED IT
      
      .Borders(xlEdgeLeft).Weight = xlMedium
      .Borders(xlEdgeRight).Weight = xlMedium
      .Borders(xlEdgeTop).Weight = xlMedium
      .Borders(xlEdgeBottom).Weight = xlMedium
  
      ActiveSheet.UsedRange.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder _
          :=xlByColumns, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
       
      Application.FindFormat.Clear
      .Clear         'IS THIS LINE CORRECT, JUST SEEMS OUT OF PLACE VISUALLY?
    End With
  End With

'ADDED THESE TWO ITEMS BELOW
  With ActiveSheet.UsedRange
     .BorderAround xlContinuous, xlMedium, xlAutomatic
  End With

Application.ScreenUpdating = True

End Sub

I was still experiencing that refresh issue, and I tried a couple of different "Calculate" type refresh items but none of them worked, I then found this piece of code that solved the issue.

Application.ScreenUpdating = True

If you or anyone else can see any issues with anything please let me know if you have the time.
Thank You again for the help you are offering me.

 

[Kenneth Hobson]

The .Clear's are fine. Your two With's make them Application.ReplaceFormat.Clear.

 

[miketurn]

@Kenneth Hobson
Thank you for your response, I figured the "clears" were okay, just wanted to be sure, such short lines of code they just stood out to a non experienced macro tweaker like myself

Again thank you for all your help and patience, the macro works great.