Is there a better way to apply conditional formats with vba?

bbalch

Board Regular
Joined
Feb 23, 2015
Messages
53
Hello everyone. I have a large macro that has evolved over time and has become quite slow. I'm making an effort to go through the code to clean it up. There are two conditional formats in the macro that apply different conditions to the range A8:I500 based on the left values in column A. I'm interested to see if there is a better way of applying the conditional format than the way I'm currently doing it.

This was originally created with the macro recorder and I believe they are applying conditional formats to cell A8 using the "left" formula, then copying cell A8 and pasting the formats to the range A8:I500 with "paste special formats". Ideally, I would like for conditional formats to be applied to the range A8:"the last cell used in column I".

When applied the formats look like this expect to all the data in columns A:I.

[Chairs]
' item 1
' item 2
[Total Chairs]
[Tvs]
[Radios]
' item 1
' item 2
' item 3
[Total Radios]

* ' used to show 4 space indent

Any suggestions are greatly appreciated.

First Conditional Format
- Sets the text to Bold if the first character in column A is "["

Code:
Range("A8").Select    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=(LEFT($A8,1)=""["")"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True 
    End With

    Selection.FormatConditions(1).StopIfTrue = False
    Selection.Copy

    Range("A8:I500").Select

    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
Second Conditional Format
- Sets the text to Bold = False if the 1st characters in A8 are " "
Code:
   Range("A8").Select    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=(LEFT($A8,4)=""    "")"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = False
        .Italic = False
        .TintAndShade = 0
    End With
    
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.Copy
    
    Range("A8:I500").Select
    
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
31,944
Office Version
365
Platform
Windows
How about
Code:
   Dim Lr As Long
   Lr = Range("A" & Rows.count).End(xlUp).Row
   With Range("A8:I" & Lr)
      .FormatConditions.Add Type:=xlExpression, Formula1:= _
         "=(LEFT($A8,1)=""["")"
      .FormatConditions(.FormatConditions.count).SetFirstPriority
      With .FormatConditions(1).Font
          .Bold = True
      End With
      .FormatConditions(1).StopIfTrue = False
      
      .FormatConditions.Add Type:=xlExpression, Formula1:= _
         "=(LEFT($A8,4)=""    "")"
      .FormatConditions(.FormatConditions.count).SetFirstPriority
      With .FormatConditions(1).Font
          .Bold = False
          .Italic = False
          .TintAndShade = 0
      End With
    
      .FormatConditions(1).StopIfTrue = False
   End With
 

Forum statistics

Threads
1,081,456
Messages
5,358,798
Members
400,513
Latest member
sdrowsick

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top