Excel 特定の文字の色を一括設定するマクロ

エクセルで、特定の文字の色を変えるマクロを作成しました。

Sub Macro_特定の文字の色を一括設定()
 Dim rng As Range
 Dim ptr As Integer
 Const tStr As String = "□" 'ここに色を変える文字列を書く
 Const tClr As Variant = &H6BE2 'ここに設定する色を書く
 For Each rng In ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 23)
   ptr = InStr(rng.Value, tStr)
   While ptr > 0
     rng.Characters(Start:=ptr, Length:=Len(tStr)).Font.Color = tClr
     ptr = InStr(ptr + 1, rng.Value, tStr)
   Wend
 Next rng
End Sub