Finding cells formatted with colour gradients of various colours

[KenWilson]

Hi, Happy Halloween, everyone!

Can anybody make mine happier by telling me whether it is possible with VBA to search a range and count the cells which have an .interior with a particular colour gradient using two colours? I'm using Excel 2007.

Yours hopefully,


Ken

[SamT]

Search the net for "VBA Using findformat"
From: https://docs.microsoft.com/en-us/off...ormat.Interior

Sub SearchCellFormat() 
 
 ' Set the search criteria for the interior of the cell format. 
 With Application.FindFormat.Interior 
    .ColorIndex = 6 
    .Pattern = xlSolid 
    .PatternColorIndex = xlAutomatic 
 End With 
 
  
 ' Find the cells based on the search criteria. 
 Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ 
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ 
    , SearchFormat:=True).Activate 
 MsgBox "Microsoft Excel has found this cell matching the search criteria." 
 
End Sub

[KenWilson]

Search the net for "VBA Using findformat"
From: https://docs.microsoft.com/en-us/off...ormat.Interior

Sub SearchCellFormat() 
 
 ' Set the search criteria for the interior of the cell format. 
 With Application.FindFormat.Interior 
    .ColorIndex = 6 
    .Pattern = xlSolid 
    .PatternColorIndex = xlAutomatic 
 End With 
 
  
 ' Find the cells based on the search criteria. 
 Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ 
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ 
    , SearchFormat:=True).Activate 
 MsgBox "Microsoft Excel has found this cell matching the search criteria." 
 
End Sub

[KenWilson]

Thanks, SamT. I'll try out that method, BUT...

...Interior.ColorIndex =6 and .Pattern=xlSolid cause me to pause before doing so because they don't look as though they will find cells with a particular colour gradient. I am working with two different interior gradients (not solid colours which, by the way, which I also use but for a different purpose and which I know a way of finding) and need to be able to detect them separately. In creating the gradients I used the following code but I just haven't hit on the way to detect the values of the diagnostic parameters (presumably "ColourA" and "ColourB" in this example) in the cells being searched for:
With CellRange.Interior
.Pattern= xlPatternLinearGradient
With .Gradient
.Degree = 0
With .ColorStops
.Clear
With .Add(0)
.Color = ColourA
.TintAndShade = 0
End With
With .Add(1)
.Color = ColourB
.TintAndShade = 0
End With
End With
End With
End With
Any thoughts on this would be greatly appreciated.

Regards,

Ken

[SamT]

From the looks of your code, I would try something like

With CellRange.Interior
    .Pattern= xlPatternLinearGradient
    .GradientDegree:=0
    .ColorStops.Clear
    .Add(0) Color:=ColourA, TintAndShade:= 0
    .Add(1) Color:=ColourB, TintAndShade:=0
End With

But you will need to do some more research to make sure. I don't use Excel 7+, so I don't really know all those properties
In VBA, try looking at what pressing F2 does for you

[Paul_Hossler]

What I like to do is select a cell that has the pattern (or what ever) that I want to match, and use its characteristics, but you can adapt the logic to use predetermined values for settings

Option Explicit


Sub Find_Cells()
    Dim r1 As Range, r2 As Range
    Dim oInt As Interior
        
    Range("A1").Select      '   <<<<<<<<<<<<<<<<<<<< for testing
        
    Set r2 = ActiveCell  '   one with the gradient to match
    
    Set oInt = r2.Interior
        
    If oInt.Pattern <> xlPatternLinearGradient Then
        MsgBox "Wrong kind of cell"
        Exit Sub
    End If
    
    
    For Each r1 In ActiveSheet.UsedRange.Cells
        With r1.Interior
            On Error GoTo TryNext
            If oInt.Pattern <> .Pattern Then GoTo TryNext
            If oInt.Gradient.Degree <> .Gradient.Degree Then GoTo TryNext
            If oInt.Gradient.ColorStops(1).Color <> .Gradient.ColorStops(1).Color Then GoTo TryNext
            If oInt.Gradient.ColorStops(2).Color <> .Gradient.ColorStops(2).Color Then GoTo TryNext
    
            Set r2 = Union(r2, r1)
    
        End With
        
TryNext:
        On Error GoTo 0
    Next


    MsgBox r2.Address


End Sub

[SamT]

Thank you, Paul

Using Paul's code as a pattern

With CellRange.Interior
    .Pattern= xlPatternLinearGradient
    .GradientDegree:=0
    .ColorStops(1) Color:=ColourA, TintAndShade:= 0
    .ColorStops(2) Color:=ColourB, TintAndShade:=0
End With

[KenWilson]

Thank you, Paul

Using Paul's code as a pattern

With CellRange.Interior
    .Pattern= xlPatternLinearGradient
    .GradientDegree:=0
    .ColorStops(1) Color:=ColourA, TintAndShade:= 0
    .ColorStops(2) Color:=ColourB, TintAndShade:=0
End With

Many thanks, Paul & Sam,

You've given me a lead which I hope will take me further. I'll look up what the F2 tip is about ; I only ever use F5 and F8.

Gratefully,
Ken