Apply Conditional Formatting Through VBA

T

TaskMaster

Board Regular
Joined
Oct 15, 2020
Messages
75
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi all,

Hoping you could help me with my issue. I wanted to add databars to my spreadsheet however when doing manually I got the error cannot use relative references which would mean applying the same formula over and over again. A way around this I thought would be to use vba to apply this. This works for the first set of formatting but when using the others it seems to overwrite it even though the parameters are different could anyone provide a solution to this. I need this for 6 different people. I want the conditions of the data bar be a different colour for each person, where the persons name is in column F.

VBA Code: 
Sub Data_Bar_James()
Dim r As Integer
Dim lr As Integer

lr = Cells(Rows.Count, "F").End(xlUp).Row
Application.ScreenUpdating = False
        
    For r = 2 To lr
    
        With Range("G" & r)
            .FormatConditions.AddDatabar
          With .FormatConditions(1)
        .MinPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""James"",0,"""")"
        .MaxPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""James"",1,"""")"
                .ShowValue = True
                .BarFillType = xlDataBarFillSolid
                .BarColor.Color = 2222055
            End With
       End With
            
        Next r

Application.ScreenUpdating = False

End Sub
Sub Data_Bar_Tim()
Dim r As Integer
Dim lr As Integer

lr = Cells(Rows.Count, "F").End(xlUp).Row
Application.ScreenUpdating = False
              
    For r = 2 To lr
    
        With Range("G" & r)
            .FormatConditions.AddDatabar
          With .FormatConditions(1)
        .MinPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""Tim"",0,"""")"
        .MaxPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""Tim"",1,"""")"
                .ShowValue = True
                .BarFillType = xlDataBarFillSolid
                .BarColor.Color = 255
            End With
       End With
            
        Next r
        
Application.ScreenUpdating = False

End Sub
Sub Data_Bar_Lisa()
Dim r As Integer
Dim lr As Integer

lr = Cells(Rows.Count, "F").End(xlUp).Row
Application.ScreenUpdating = False
            
    For r = 2 To lr
    
        With Range("G" & r)
            .FormatConditions.AddDatabar
          With .FormatConditions(1)
        .MinPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""Lisa"",0,"""")"
        .MaxPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""Lisa"",1,"""")"
                .ShowValue = True
                .BarFillType = xlDataBarFillSolid
                .BarColor.Color = 15523812
            End With
       End With
            
        Next r
        
Application.ScreenUpdating = False

End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sort by date Sort by votes
Format conditions are a collection so each time you add a format condition you are adding to the collection. .FormatConditions(1) is just the first one, and you are creating many more. Here is one way to modify.

VBA Code: 
Sub Data_Bar_James()
    Dim r As Integer
    Dim lr As Integer
    
    lr = Cells(Rows.Count, "F").End(xlUp).Row
    Application.ScreenUpdating = False
    
    'Delete any previous format conditions.
    Range("F2", Range("F" & Rows.Count).End(xlUp)).Offset(, 1).FormatConditions.Delete
    
    
    For r = 2 To lr
        With Range("G" & r)
            '.FormatConditions.AddDatabar
            With .FormatConditions.AddDatabar
                .MinPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""James"",0,"""")"
                .MaxPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""James"",1,"""")"
                .ShowValue = True
                .BarFillType = xlDataBarFillSolid
                .BarColor.Color = 2222055
            End With
        End With
    Next r
    
    Application.ScreenUpdating = False
End Sub

Sub Data_Bar_Tim()
    Dim r As Integer
    Dim lr As Integer
    
    lr = Cells(Rows.Count, "F").End(xlUp).Row
    Application.ScreenUpdating = False
    
    'Delete any previous format conditions.
    Range("F2", Range("F" & Rows.Count).End(xlUp)).Offset(, 1).FormatConditions.Delete
    For r = 2 To lr
        
        With Range("G" & r)
            .FormatConditions.AddDatabar
            '.FormatConditions.AddDatabar
            With .FormatConditions.AddDatabar
                .MinPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""Tim"",0,"""")"
                .MaxPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""Tim"",1,"""")"
                .ShowValue = True
                .BarFillType = xlDataBarFillSolid
                .BarColor.Color = 255
            End With
        End With
        
    Next r
    
    Application.ScreenUpdating = False
End Sub

Sub Data_Bar_Lisa()
    Dim r As Integer
    Dim lr As Integer
    
    lr = Cells(Rows.Count, "F").End(xlUp).Row
    Application.ScreenUpdating = False
    
    'Delete any previous format conditions.
    Range("F2", Range("F" & Rows.Count).End(xlUp)).Offset(, 1).FormatConditions.Delete
    
    For r = 2 To lr
        With Range("G" & r)
            '.FormatConditions.AddDatabar
            With .FormatConditions.AddDatabar
                .MinPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""Lisa"",0,"""")"
                .MaxPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""Lisa"",1,"""")"
                .ShowValue = True
                .BarFillType = xlDataBarFillSolid
                .BarColor.Color = 15523812
            End With
        End With
    Next r
    
    Application.ScreenUpdating = False
End Sub
 
Upvote 1
Solution
T
rlv01 said:
Format conditions are a collection so each time you add a format condition you are adding to the collection. .FormatConditions(1) is just the first one, and you are creating many more. Here is one way to modify.

VBA Code: 
Sub Data_Bar_James()
    Dim r As Integer
    Dim lr As Integer
   
    lr = Cells(Rows.Count, "F").End(xlUp).Row
    Application.ScreenUpdating = False
   
    'Delete any previous format conditions.
    Range("F2", Range("F" & Rows.Count).End(xlUp)).Offset(, 1).FormatConditions.Delete
   
   
    For r = 2 To lr
        With Range("G" & r)
            '.FormatConditions.AddDatabar
            With .FormatConditions.AddDatabar
                .MinPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""James"",0,"""")"
                .MaxPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""James"",1,"""")"
                .ShowValue = True
                .BarFillType = xlDataBarFillSolid
                .BarColor.Color = 2222055
            End With
        End With
    Next r
   
    Application.ScreenUpdating = False
End Sub

Sub Data_Bar_Tim()
    Dim r As Integer
    Dim lr As Integer
   
    lr = Cells(Rows.Count, "F").End(xlUp).Row
    Application.ScreenUpdating = False
   
    'Delete any previous format conditions.
    Range("F2", Range("F" & Rows.Count).End(xlUp)).Offset(, 1).FormatConditions.Delete
    For r = 2 To lr
       
        With Range("G" & r)
            .FormatConditions.AddDatabar
            '.FormatConditions.AddDatabar
            With .FormatConditions.AddDatabar
                .MinPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""Tim"",0,"""")"
                .MaxPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""Tim"",1,"""")"
                .ShowValue = True
                .BarFillType = xlDataBarFillSolid
                .BarColor.Color = 255
            End With
        End With
       
    Next r
   
    Application.ScreenUpdating = False
End Sub

Sub Data_Bar_Lisa()
    Dim r As Integer
    Dim lr As Integer
   
    lr = Cells(Rows.Count, "F").End(xlUp).Row
    Application.ScreenUpdating = False
   
    'Delete any previous format conditions.
    Range("F2", Range("F" & Rows.Count).End(xlUp)).Offset(, 1).FormatConditions.Delete
   
    For r = 2 To lr
        With Range("G" & r)
            '.FormatConditions.AddDatabar
            With .FormatConditions.AddDatabar
                .MinPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""Lisa"",0,"""")"
                .MaxPoint.Modify newtype:=xlConditionValueFormula, newvalue:="=IF(Whiteboard!$F$" & r & "=""Lisa"",1,"""")"
                .ShowValue = True
                .BarFillType = xlDataBarFillSolid
                .BarColor.Color = 15523812
            End With
        End With
    Next r
   
    Application.ScreenUpdating = False
End Sub
Click to expand...
This works perfectly thank you!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Help making my VBA code apply to only one column
Replies
2
Views
551
Alex Blakenburg
A
S
  • Solved
Copy values only without specific column formats VBA
Replies
9
Views
387
sofas
S
A
  • Question Question
VBA Combine macros in one depending on text string
Replies
2
Views
510
mumps
mumps
O
  • Solved
Combining two VBA Codes Change (ByVal Target) and (ByVal Destination)
2
Replies
10
Views
2K
OscarMDMBA
O
E
  • Question Question
VBA code clean up
Replies
9
Views
536
mumps
mumps

Forum statistics

Threads
1,223,885
Messages
6,175,187
Members
452,616
Latest member
intern444

Share this page

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
Back
Top