I wasn't deriving k correctly. Instead of doing it for each cell, I had only
done it once initially. Try this:-
Sub ColText()
Dim i As Long
Dim j As Integer
Dim k As Integer
Dim num As Long
Dim ans As String
Dim str As String
ans = InputBox("What string do you want to find")
i = Application.WorksheetFunction.CountIf(ActiveSheet. UsedRange, "*" & ans &
"*")
j = Len(ans)
Cells.Find(what:=ans, after:=ActiveCell, LookIn:=xlValues, lookat:= _
xlPart, MatchCase:=False).Activate
For num = 1 To i
k = Application.WorksheetFunction.Find(ans, ActiveCell)
With ActiveCell.Characters(Start:=k, Length:=j).Font
.ColorIndex = 3
.Bold = True
End With
Cells.FindNext(after:=ActiveCell).Activate
Next num
End Sub
--
Regards
Ken....................... Microsoft MVP - Excel
Sys Spec - Win XP Pro / XL 00/02/03
----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission :-)
----------------------------------------------------------------------------
<snip
---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (
http://www.grisoft.com).
Version: 6.0.598 / Virus Database: 380 - Release Date: 28/02/2004