Find and colour all cells with Validation
 

Looking for VBA that will turn cells blue, if they have any validation rules
applied to it. Is this possible?
How?
I have something similar that makes all unlocked cells Yellow. It works like
a charm and is lightning fast.
But I don't know enough coding to change that code to suit this application.

Dim cell As Range, tempR As Range, rangeToCheck As Range
Cells.Select
Cells.Interior.ColorIndex = -4142
For Each cell In Intersect(Selection, _
ActiveSheet.UsedRange)

' If cell has validation then colour cell blue
Code needed he <<<?


Old Code (If Not cell.Locked Then
If tempR Is Nothing Then
Set tempR = cell
Else
Set tempR = Union(tempR, cell)
End If
End If

Next cell
If tempR Is Nothing Then
MsgBox "There are no Cells with Validation " & _
"in the selected range."
End
End If

'Select qualifying cells
'TempR.Select
tempR.Interior.ColorIndex = 5 'Blue

End Sub

Find and colour all cells with Validation
 

BEEJAY,

Cells.SpecialCells(xlCellTypeAllValidation).Interi or.ColorIndex = 5

DO NOT use the "For Each cell in ...." construct. There is no need for it with this code.

HTH,
Bernie
MS Excel MVP


"BEEJAY" wrote in message
...
Looking for VBA that will turn cells blue, if they have any validation rules
applied to it. Is this possible?
How?
I have something similar that makes all unlocked cells Yellow. It works like
a charm and is lightning fast.
But I don't know enough coding to change that code to suit this application.

Dim cell As Range, tempR As Range, rangeToCheck As Range
Cells.Select
Cells.Interior.ColorIndex = -4142
For Each cell In Intersect(Selection, _
ActiveSheet.UsedRange)

' If cell has validation then colour cell blue
Code needed he <<<?


Old Code (If Not cell.Locked Then
If tempR Is Nothing Then
Set tempR = cell
Else
Set tempR = Union(tempR, cell)
End If
End If

Next cell
If tempR Is Nothing Then
MsgBox "There are no Cells with Validation " & _
"in the selected range."
End
End If

'Select qualifying cells
'TempR.Select
tempR.Interior.ColorIndex = 5 'Blue

End Sub