Snasui Excel Forum

Code: Select all

Dim strString1, x&
For i = 0 To 3133
strString1 = Range("A1")
With Range("B2").Offset(0, i)
.Font.ColorIndex = 1
For x = 1 To Len(.Text) Step 1
If Mid(.Text, x, Len(strString1)) = strString1 Then .Characters(x, Len(strString1)).Font.ColorIndex = 3
Next x
End With
Next i

Dim strString2, y&
For t = 0 To 3133
strString2 = Range("A2")
With Range("B2").Offset(0, t)
.Font.ColorIndex = 1
For y = 1 To Len(.Text) Step 1
If Mid(.Text, y, Len(strString2)) = strString2 Then .Characters(y, Len(strString2)).Font.ColorIndex = 4
Next y
End With
Next t

Code: Select all

Sub test()
    Dim rAll As Range, r As Range, i%, j%
    With Sheets(1)
        Set rAll = .Range("b2", .Range("b2").End(xlToRight))
    End With
    For Each r In rAll
        If InStr(r.Value, Range("a1").Value) <> 0 Then
            i = InStr(r.Value, Range("a1").Value)
            j = Len(Range("a1").Value)
            r.Characters(Start:=i, Length:=j).Font.Color = vbRed
        End If
        If InStr(r.Value, Range("a2").Value) <> 0 Then
            i = InStr(r.Value, Range("a2").Value)
            j = Len(Range("a2").Value)
            r.Characters(Start:=i, Length:=j).Font.Color = vbGreen
        End If
    Next r
End Sub

Code: Select all

Dim rAll As Range, r As Range, i%, j%