Раскрасить часть текста в ячейке - VB

Sub cehout()
    Application.ScreenUpdating = False
    massceh = Sheets("коды").UsedRange.Value
    arrlist = ActiveSheet.UsedRange.Value
    Ncolumn1 = Columns(1)
    Ncolumn2 = Columns(2)
    For i = 2 To UBound(arrlist)
        For j = LBound(massceh) To UBound(massceh)
            If InStr(1, Cells(i, Ncolumn2), massceh(j, 1)) > 0 Then
                If InStr(Cells(i, Ncolumn1), massceh(j, 2)) > 0 Then
                    intFoundPosition = InStr(1, Cells(i, Ncolumn1), massceh(j, 2))
                    Do While intFoundPosition > 0
                        Cells(i, Ncolumn1).Characters(intFoundPosition, Len(massceh(j, 2))).Font.color = -11489280 'зелёный
                        intFoundPosition = InStr(intFoundPosition + 1, Cells(i, Ncolumn1), massceh(j, 2), vbTextCompare)
                    Loop
                End If
            End If
        Next j
    Next i
    Application.ScreenUpdating = True
End Sub