Solved: How to colour tags?

[antonin]

In need a procedure which, in all cells in the current worksheet, finds all strings starting with "<" and ending with ">" and changes the colour of the font for all such strings.

When I try to use the "Find" method of Excel VBA, it only gives me the cell in which the searched string is, but how can I search text within the cell?

[Bob Phillips]

Sub Macro1()
Dim iStart As Long
Dim iEnd As Long
Dim oCell As Range
Dim FirstAddress

With Worksheets("Sheet2").Cells
Set oCell = .Find("<", LookIn:=xlValues)
If Not oCell Is Nothing Then
FirstAddress = oCell.Address
Do
iStart = InStr(oCell.Value, "<")
iEnd = InStr(oCell.Value, ">")
If iEnd > 0 Then
oCell.Characters(iStart + 1, iEnd - iStart - 1).Font.ColorIndex = 3
End If
Set oCell = .FindNext(oCell)
Loop While Not oCell Is Nothing And oCell.Address <> FirstAddress
End If
End With
End Sub

[antonin]

Oh, great, thank you very much. I will test it right away!

Antonin

[antonin]

I adapted your code to colour the tag delimiters as well, and to colour several tags in a cell. Perhaps it could have been done in a more elegant way? But the result counts and it seems to work...

Sub colour_tags()


Dim iStart As Long
Dim iEnd As Long
Dim oCell As Range
Dim FirstAddress

With Worksheets("Sheet1").Cells
Set oCell = .Find("<", LookIn:=xlValues)
If Not oCell Is Nothing Then
FirstAddress = oCell.Address
Do
strng = oCell.Value
corr = 0
lab1:
iStart = InStr(strng, "<")
iEnd = InStr(strng, ">")
If iEnd > 0 Then
oCell.Characters(corr + iStart, iEnd - iStart + 1).Font.ColorIndex = 3
Else
GoTo lab2
End If
lgd = Len(strng)
lgk = lgd - iEnd
strng = Right(strng, lgk)
corr = corr + iEnd
GoTo lab1
lab2:
Set oCell = .FindNext(oCell)
Loop While Not oCell Is Nothing And oCell.Address <> FirstAddress
End If
End With

End Sub

[austenr]

If your question has been answered, please mark your thread solved. Thanks :thumb

[antonin]

I do believe I marked it "solved" long before you told me to - or did I do it in a wrong way?