Apply Conditional Formatting Through VBA

T

TaskMaster

Board Regular
Joined
Oct 15, 2020
Messages
55
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

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
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

A
  • Question
VBA Combine macros in one depending on text string
Replies
2
Views
340
mumps
mumps
O
  • Solved
Combining two VBA Codes Change (ByVal Target) and (ByVal Destination)
2
Replies
10
Views
946
OscarMDMBA
O
Guna13
  • Question
Help to Optimize Macro Code for Faster Performance
Replies
0
Views
754
Guna13
Guna13
S
  • Question
Copy data from one sheet to another, provided
Replies
1
Views
394
sofas
S
M
  • Question
Loop through each file in folder and perform an action
Replies
0
Views
469
Monsieur Roo
M

Forum statistics

Threads
1,215,069
Messages
6,122,959
Members
449,096
Latest member
Anshu121

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