Find value loop not working

[Christiane]

Hi.

This loop is driving me nuts.

I want to search in a range ("A1:U50") to find cells containing th
word "totals" (there is other text in the cell);

when I find such a cell, I want to apply certain formatting to a cel
below it (this part I am ok with).

WHen it finds all the cells, I want the loop to end, but it doesn'
stop!

My code

Sub FormatMonths ()

With worksheets("unit forecast").range("A1:U50")


chktot=cells.find(what:="*totals*").activate

Do while chcktot=true
activecell.offset(1,0).range("a1").select
Selection.font.colorindex=3

cells.find(what:="*totals*").activate

Loop

End With

End Sub


Please help if you can.
CHristiane



:confused

 

[Bob Phillips]

Hi Christiane,

Try this

With Worksheets("unit forecast").Range("A1:U50")
On Error Resume Next
Set oCell = .Find(what:="totals", lookat:=xlPart)
If Not oCell Is Nothing Then
sFirst = oCell.Address
Do
oCell.Offset(1, 0).Font.ColorIndex = 3
Set oCell = .FindNext(oCell)
Loop While Not oCell Is Nothing And oCell.Address <> sFirst
End If
End With

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Ron de Bruin]

Hi Christiane

Try this

For changing the Font color use this .Font.ColorIndex = 0
'change the font in the column to Automatic rng.Font.ColorIndex = 3
'make the font of the cell red
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("totals")
'You can also use more values in the Array
'myArr = Array("ron", "dave")

With Sheets("Sheet1").Range("A1:U50")

.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:=xlFormulas, _
LookAt:=xlPart, _
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

 

[Christiane]

Thank you.

It works fine