Color Cells on Find

[Dennis]

I found this in the NG archives and use it at work with EXCEL 2000.

Sub Color_cells_in_Range()
Dim FirstAddress As String
Dim myArr As Variant
Dim rng As Range
Dim I As Long

Application.ScreenUpdating = False
myArr = Array("7", "27")
'You can also use more values in the Array
'myArr = Array("ron", "dave")

With Sheets("Sheet1").Range("B1:G500")

.Interior.ColorIndex = xlColorIndexNone
'change the fill color to "no fill" in all cells

For I = LBound(myArr) To UBound(myArr)
Set rng = .Find(What:=myArr(I), _
After:=Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
'if you use LookIn:=xlValues it will also work with a
'a formula cell that evaluates to "ron"

If Not rng Is Nothing Then
FirstAddress = rng.Address
Do
rng.Interior.ColorIndex = 3
'make the cell red
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <>
FirstAddress
End If
Next I
End With
Application.ScreenUpdating = True
End Sub


At home with 2003 I get a syntax error on "Loop While Not rng Is Nothing And
rng.Address <>"

TIA

Dennis
===========

 

[Dennis]

That seems to just be a wrap issue, but now I get a Runtime13 on...

Set rng = .Find(What:=myArr(I), _
After:=Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

Dennis
===========

 

[Frank Kabel]

Hi Dennis
besides your linewrap issue (which you have found yourself) you have to
change the Find statement as follows:
Set rng = .Find(What:=myArr(I), _
After:=Range("B1"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

Reason: the cell for 'After' has to be within your search range (which
is B1:G500)

 

[Ron de Bruin]

Hi guys

With this sub you only have to change the range
**With Sheets("Sheet1").Range("B1:G500")**


Sub Color_cells_in_Range()
Dim FirstAddress As String
Dim myArr As Variant
Dim rng As Range
Dim I As Long

Application.ScreenUpdating = False
myArr = Array("ron")
'You can also use more values in the Array
'myArr = Array("ron", "dave")

With Sheets("Sheet1").Range("B1:G500")

.Interior.ColorIndex = xlColorIndexNone
'change the fill color to "no fill" in all cells

For I = LBound(myArr) To UBound(myArr)
Set rng = .Find(What:=myArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
'If you want to search in a part of the rng.value then use xlPart
'if you use LookIn:=xlValues it will also work with a
'a formula cell that evaluates to "ron"

If Not rng Is Nothing Then
FirstAddress = rng.Address
Do
rng.Interior.ColorIndex = 3
'make the cell red
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> FirstAddress
End If
Next I
End With
Application.ScreenUpdating = True
End Sub

 

[Dennis]

Thanx for the help on this Frank and Ron.

I'm getting close to having it work for what I need. Now What I'm getting is a
Run Time 91 on the "Loop While Not rng Is Nothing And rng.Address <>
FirstAddress"

Here's how I use Ron's code....

Sub Color_cells_in_Range()
Dim FirstAddress As String
Dim myArr As Variant
Dim rng As Range
Dim I As Long

Application.ScreenUpdating = False
myArr = Array("7", "12", "17", "22", "27", "32")
'You can also use more values in the Array
'myArr = Array("ron", "dave")

With Sheets("Sheet1").Range("B1:G500")

.Interior.ColorIndex = xlColorIndexNone
'change the fill color to "no fill" in all cells

For I = LBound(myArr) To UBound(myArr)
Set rng = .Find(What:=myArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
'If you want to search in a part of the rng.value then use xlPart
'if you use LookIn:=xlValues it will also work with a
'a formula cell that evaluates to "ron"

If Not rng Is Nothing Then
FirstAddress = rng.Address
Do
rng.Interior.ColorIndex = 3
'make the cell red
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> FirstAddress
End If
Next I
End With
Application.ScreenUpdating = True
End Sub

 

[Ron de Bruin]

Hi Dennis

I can't reproduce this error with this example in 2002.
I will try it in 2003

 

[Ron de Bruin]

Hi Dennis

Also no problem in 2003
Send me your test workbook private and I will look at it

 

[Ron de Bruin]

Hi Dennis

You problem is that you use Merge cells
Avoid using it (always trouble)

 

[Dennis]

Doh!!!! Thanx for the help, I was stumped. This is data I copy and paste from
the web, I'll un-merge first. Thanx again.

Dennis
===============