Finding cells formatted with colour gradients of various colours

[KenWilson]

Hi, Happy Halloween, everyone!:devil2:

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/office/vba/api/Excel.CellFormat.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/office/vba/api/Excel.CellFormat.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 :think:; I only ever use F5 and F8.

Gratefully,
Ken