• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to create gradient-shaded color in Conditional Format?

Eloise T

Eloise T

Active Member
The following picture says it best:

upload_2017-8-31_11-23-33.png
I created a new spreadsheet with only 3 colored cells and went through the Developer tab --> Record Macro to get the "code" for setting the colors to gradient-shading, etc., and of course it won't allow me to plug it in directly to the "real" workbook without a few changes.

The first VBA code (see below) is my feeble attempt to "fit" the Recorded Macro in to a partial of the "real" spreadsheet where there are only 4 lines that seem to be a problem. This is before knowing whether or not it will work once the gradient-shading code has been incorporated in, but I'm believing the best.

The 2nd VBA code is solely the VBA code coughed up by the Record Macro. I have also uploaded the file which I created to get the Recorded Macro.

I can also upload the entire sanitized version of the "real" spreadsheet before my attempt to incorporate the Recorded Macro in if anyone thinks that would help, but I think everything needed to solve this conundrum is currently included.

THANK YOU for your help.



Code: 
Sub Conditional_Format_Reset()
  Dim ws As Worksheet
  For Each ws In ThisWorkbook.Worksheets


  If ws.Cells(Rows.Count, 3).End(xlUp).Row > 2 Then
  lLastRow = ws.Cells(Rows.Count, 3).End(xlUp).Row - 2



  With ws.Range("C3:C" & lLastRow)  'Intended Range =$C$3:$C$5003

'  Using a "Formulas" tab --> Name Manager, find all the 70 models and color them as designated below.

  .FormatConditions.Add Type:=xlExpression, Formula1:="=OR(ISNUMBER(SEARCH(SearchFor70,$C3)))"
  .FormatConditions(.FormatConditions.Count).Font.ColorIndex = 1  'Black
  .FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 3  'Red

  .FormatConditions(.FormatConditions.Count).SetFirstPriority
  .FormatConditions(.FormatConditions.Count).Font.Bold = True
  .FormatConditions(.FormatConditions.Count).Font.Italic = False
  .FormatConditions(.FormatConditions.Count).Font.TintAndShade = 0
'  End With
'  .FormatConditions(.FormatConditions.Count).Interior
  .FormatConditions(.FormatConditions.Count).Interior.Pattern = xlPatternLinearGradient
  .FormatConditions(.FormatConditions.Count).Interior.Gradient.Degree = 0
  .FormatConditions(.FormatConditions.Count).Interior.Gradient.ColorStops.Clear
'  End With
  .FormatConditions(.FormatConditions.Count).Interior.Gradient.ColorStops.Add (0)

'  T R Y I N G  T O  F I G U R E  O U T  G R A D I E N T - S H A D I N G.
'  T H E  F O L L O W I N G  F O U R  L I N E S  W I T H  D O U B L E  ' '  C O M M E N T S
'  N E E D  T O  "F I T"  I N  B U T  I  D O  N O T  H O W  T O  M O D I F Y  T H E M
'  T O  G E T  T H E M  T O  W O R K.


' '  .FormatConditions(.FormatConditions.Count).Interior.Gradient.ThemeColor = xlThemeColorDark1
' '  .FormatConditions(.FormatConditions.Count).Interior.Gradient.TintAndShade = 0
'  End With
  .FormatConditions(.FormatConditions.Count).Interior.Gradient.ColorStops.Add (1)
' '  .FormatConditions(.FormatConditions.Count).Interior.Gradient.Color = 16711680
' '  .FormatConditions(.FormatConditions.Count).Interior.Gradient.TintAndShade = 0
'  End With

  .FormatConditions(.FormatConditions.Count).StopIfTrue = False
  End With
  End If
  Next
End Sub
Code: 
Sub Macro1()
'
' Macro1 Macro
'

'
' G10 --------------------------------------------------------------------

  Selection.FormatConditions.Add Type:=xlTextString, String:="abcdef", _
  TextOperator:=xlContains
  Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
  With Selection.FormatConditions(1).Font
  .Bold = True
  .Italic = False
  .TintAndShade = 0
  End With
  With Selection.FormatConditions(1).Interior
  .Pattern = xlPatternLinearGradient
  .Gradient.Degree = 0
  .Gradient.ColorStops.Clear
  End With
  With Selection.FormatConditions(1).Interior.Gradient.ColorStops.Add(0)
  .ThemeColor = xlThemeColorDark1
  .TintAndShade = 0
  End With
  With Selection.FormatConditions(1).Interior.Gradient.ColorStops.Add(1)
  .Color = 255
  .TintAndShade = 0
  End With
  Selection.FormatConditions(1).StopIfTrue = False

' G11 --------------------------------------------------------------------

  Range("G11").Select
  Selection.FormatConditions.Add Type:=xlTextString, String:="123456", _
  TextOperator:=xlContains
  Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
  With Selection.FormatConditions(1).Font
  .Bold = True
  .Italic = True
  .TintAndShade = 0
  End With
  With Selection.FormatConditions(1).Interior
  .Pattern = xlPatternLinearGradient
  .Gradient.Degree = 0
  .Gradient.ColorStops.Clear
  End With
  With Selection.FormatConditions(1).Interior.Gradient.ColorStops.Add(0)
  .ThemeColor = xlThemeColorDark1
  .TintAndShade = 0
  End With
  With Selection.FormatConditions(1).Interior.Gradient.ColorStops.Add(1)
  .Color = 65280
  .TintAndShade = 0
  End With
  Selection.FormatConditions(1).StopIfTrue = False

' G12 --------------------------------------------------------------------

  Range("G12").Select
  Selection.FormatConditions.Add Type:=xlTextString, String:="xyz", _
  TextOperator:=xlContains
  Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
  With Selection.FormatConditions(1).Font
  .Bold = True
  .Italic = False
  .Underline = xlUnderlineStyleSingle
  .TintAndShade = 0
  End With
  With Selection.FormatConditions(1).Interior
  .Pattern = xlPatternLinearGradient
  .Gradient.Degree = 0
  .Gradient.ColorStops.Clear
  End With
  With Selection.FormatConditions(1).Interior.Gradient.ColorStops.Add(0)
  .ThemeColor = xlThemeColorDark1
  .TintAndShade = 0
  End With
  With Selection.FormatConditions(1).Interior.Gradient.ColorStops.Add(1)
  .Color = 16711680
  .TintAndShade = 0
  End With
  Selection.FormatConditions(1).StopIfTrue = False
  Range("G12").Select
End Sub

P.S. Why is it sometimes, probably 50% of the time I try to Record Macro, it doesn't work and I only get:

Code: 
Sub Macro1()
'' Macro1 Macro'
'
End Sub
???
 

Attachments

  • Chandoo - gradient shading.xlsm
    20.5 KB · Views: 4
Last edited:
Hi ,

Try this :
Code: 
Sub Conditional_Format_Reset()
    Dim ws As Worksheet
    Dim grd1 As LinearGradient
    Dim cs As ColorStop
   
    For Each ws In ThisWorkbook.Worksheets
        If ws.Cells(Rows.Count, 3).End(xlUp).Row >= 0 Then
          lLastRow = 17 'ws.Cells(Rows.Count, 3).End(xlUp).Row - 2

          With ws.Range("C3:C" & lLastRow)  'Intended Range =$C$3:$C$5003
'              Using a "Formulas" tab --> Name Manager, find all the 70 models and color them as designated below.
                .FormatConditions.Delete
                .FormatConditions.Add Type:=xlExpression, Formula1:="=OR(ISNUMBER(SEARCH(SearchFor70,$C3)))"
                With .FormatConditions(.FormatConditions.Count)
                    With .Font
                          .ColorIndex = 1  'Black
                          .Bold = True
                          .Italic = False
                          .TintAndShade = 0
                    End With
 
                    With .Interior
                          .ColorIndex = 3  'Red
                          .Pattern = xlPatternLinearGradient
                          Set grd1 = .Gradient
                          With grd1
                              .Degree = 0
                              .ColorStops.Clear
                              Set cs = .ColorStops.Add(0.25)
                              With cs
                                    .Color = vbRed
                                    .TintAndShade = 0.75
                              End With
   
                              Set cs = .ColorStops.Add(0.5)
                              With cs
                                    .Color = vbRed
                                    .TintAndShade = 0.5
                              End With
   
                              Set cs = .ColorStops.Add(0.75)
                              With cs
                                    .Color = vbRed
                                    .TintAndShade = 0.25
                              End With
   
                              Set cs = .ColorStops.Add(1)
                              With cs
                                    .Color = vbRed
                                    .TintAndShade = 0
                              End With
                          End With
                    End With
                   
                    .StopIfTrue = False
                End With
          End With
        End If
    Next
End Sub
Narayan
 
NARAYANK991 said:
Hi ,

Try this :
Code: 
Sub Conditional_Format_Reset()
    Dim ws As Worksheet
    Dim grd1 As LinearGradient
    Dim cs As ColorStop

    For Each ws In ThisWorkbook.Worksheets
        If ws.Cells(Rows.Count, 3).End(xlUp).Row >= 0 Then
          lLastRow = 17 'ws.Cells(Rows.Count, 3).End(xlUp).Row - 2

          With ws.Range("C3:C" & lLastRow)  'Intended Range =$C$3:$C$5003
'              Using a "Formulas" tab --> Name Manager, find all the 70 models and color them as designated below.
                .FormatConditions.Delete
                .FormatConditions.Add Type:=xlExpression, Formula1:="=OR(ISNUMBER(SEARCH(SearchFor70,$C3)))"
                With .FormatConditions(.FormatConditions.Count)
                    With .Font
                          .ColorIndex = 1  'Black
                          .Bold = True
                          .Italic = False
                          .TintAndShade = 0
                    End With

                    With .Interior
                          .ColorIndex = 3  'Red
                          .Pattern = xlPatternLinearGradient
                          Set grd1 = .Gradient
                          With grd1
                              .Degree = 0
                              .ColorStops.Clear
                              Set cs = .ColorStops.Add(0.25)
                              With cs
                                    .Color = vbRed
                                    .TintAndShade = 0.75
                              End With

                              Set cs = .ColorStops.Add(0.5)
                              With cs
                                    .Color = vbRed
                                    .TintAndShade = 0.5
                              End With

                              Set cs = .ColorStops.Add(0.75)
                              With cs
                                    .Color = vbRed
                                    .TintAndShade = 0.25
                              End With

                              Set cs = .ColorStops.Add(1)
                              With cs
                                    .Color = vbRed
                                    .TintAndShade = 0
                              End With
                          End With
                    End With
                
                    .StopIfTrue = False
                End With
          End With
        End If
    Next
End Sub
Narayan
Click to expand...
I used the code you sent and tried (unsuccessfully) to insert it into my sanitized (co. product) code. I didn't get an error, but it didn't perform as needed.

With only the first line of code:

.FormatConditions(.FormatConditions.Count).Interior.Pattern = xlPatternLinearGradient

the cells took on the correct gradient-shading, just the wrong color.

Adding more code, line by line, didn't seem to help. I know it's close.

As I pointed out above, it initially looked like it might work as I added one line at a time and recorded the results in column 134 (lines 38-64). No doubt, I didn't properly "infuse" your code into mine.

There are 6 "modules" with repetitive code starting, as I said, starting in line 38. Once I get one module go work, I can simply copy the correct code into the other 5...obviously.

I'm uploaded my file with your code modifications "blended" in with commented results on the right in lines 38 to 64, starting in column 134.

I realize this has been a bit redundant, but I wanted to make sure I was clear.
 

Attachments

  • Chandoo - TEST Conditional Format Reset.xlsm
    810.6 KB · Views: 2
NARAYANK991 said:
Hi ,

Try this :
Code: 
Sub Conditional_Format_Reset()
    Dim ws As Worksheet
    Dim grd1 As LinearGradient
    Dim cs As ColorStop

    For Each ws In ThisWorkbook.Worksheets
        If ws.Cells(Rows.Count, 3).End(xlUp).Row >= 0 Then
          lLastRow = 17 'ws.Cells(Rows.Count, 3).End(xlUp).Row - 2

          With ws.Range("C3:C" & lLastRow)  'Intended Range =$C$3:$C$5003
'              Using a "Formulas" tab --> Name Manager, find all the 70 models and color them as designated below.
                .FormatConditions.Delete
                .FormatConditions.Add Type:=xlExpression, Formula1:="=OR(ISNUMBER(SEARCH(SearchFor70,$C3)))"
                With .FormatConditions(.FormatConditions.Count)
                    With .Font
                          .ColorIndex = 1  'Black
                          .Bold = True
                          .Italic = False
                          .TintAndShade = 0
                    End With

                    With .Interior
                          .ColorIndex = 3  'Red
                          .Pattern = xlPatternLinearGradient
                          Set grd1 = .Gradient
                          With grd1
                              .Degree = 0
                              .ColorStops.Clear
                              Set cs = .ColorStops.Add(0.25)
                              With cs
                                    .Color = vbRed
                                    .TintAndShade = 0.75
                              End With

                              Set cs = .ColorStops.Add(0.5)
                              With cs
                                    .Color = vbRed
                                    .TintAndShade = 0.5
                              End With

                              Set cs = .ColorStops.Add(0.75)
                              With cs
                                    .Color = vbRed
                                    .TintAndShade = 0.25
                              End With

                              Set cs = .ColorStops.Add(1)
                              With cs
                                    .Color = vbRed
                                    .TintAndShade = 0
                              End With
                          End With
                    End With
                
                    .StopIfTrue = False
                End With
          End With
        End If
    Next
End Sub
Narayan
Click to expand...
I tried your code verbatim:

upload_2017-9-2_15-40-25.png

upload_2017-9-2_15-42-56.png

Any suggestions?
 
NARAYANK991 said:
Hi ,

Try this :
Code: 
Sub Conditional_Format_Reset()
    Dim ws As Worksheet
    Dim grd1 As LinearGradient
    Dim cs As ColorStop
  
    For Each ws In ThisWorkbook.Worksheets
        If ws.Cells(Rows.Count, 3).End(xlUp).Row >= 0 Then
          lLastRow = 17 'ws.Cells(Rows.Count, 3).End(xlUp).Row - 2

          With ws.Range("C3:C" & lLastRow)  'Intended Range =$C$3:$C$5003
'              Using a "Formulas" tab --> Name Manager, find all the 70 models and color them as designated below.
                .FormatConditions.Delete
                .FormatConditions.Add Type:=xlExpression, Formula1:="=OR(ISNUMBER(SEARCH(SearchFor70,$C3)))"
                With .FormatConditions(.FormatConditions.Count)
                    With .Font
                          .ColorIndex = 1  'Black
                          .Bold = True
                          .Italic = False
                          .TintAndShade = 0
                    End With

                    With .Interior
                          .ColorIndex = 3  'Red
                          .Pattern = xlPatternLinearGradient
                          Set grd1 = .Gradient
                          With grd1
                              .Degree = 0
                              .ColorStops.Clear
                              Set cs = .ColorStops.Add(0.25)
                              With cs
                                    .Color = vbRed
                                    .TintAndShade = 0.75
                              End With
  
                              Set cs = .ColorStops.Add(0.5)
                              With cs
                                    .Color = vbRed
                                    .TintAndShade = 0.5
                              End With
  
                              Set cs = .ColorStops.Add(0.75)
                              With cs
                                    .Color = vbRed
                                    .TintAndShade = 0.25
                              End With
  
                              Set cs = .ColorStops.Add(1)
                              With cs
                                    .Color = vbRed
                                    .TintAndShade = 0
                              End With
                          End With
                    End With
                  
                    .StopIfTrue = False
                End With
          End With
        End If
    Next
End Sub
Narayan
Click to expand...
The latest is: I got your code to work...sometimes...so I've got to figure out why... It's hanging up at: With .LinearGradient ...and as I said, other times it works. I need a day off like SirJR where I keep the keyboard 1½ meters from my hands. :)
 
You must log in or register to reply here.
Back
Top