VBA to highlight non-English characters in one go based on RGB Color Code

[chingching831]

Hi all,

I am using the below VBA Code to highlight non-English characters. I have quite a lot of text to highlight, and I want them to be highlighted in different colours. Thus, it's a bit time consuming to use the below code. How can I modify it so that I can highlight a number of text in one go with different colours based on the RGB Code?
e.g.
c1 = RGB(255, 0, 0) 'red
c2 = RGB(255, 204, 0) 'yellow
c3 = RGB(0, 0, 255) 'blue

highlight text in red: "蜘蛛侠"
highlight text in yellow: "纵横宇宙"
highlight text in blue: "动画"

Sub HighlightStrings_CaseInsensitive_AllowForeignText_NotExactText()
    Dim xHStr As String, xStrTmp As String
    Dim xHStrLen As Long, xCount As Long, i As Long
    Dim xCell As Range
    Dim xArr
    
    On Error Resume Next
    xHStr = Application.InputBox("What are the words to highlight:", "Word Highlighter")
    If TypeName(xHStr) <> "String" Then Exit Sub
    
    Application.ScreenUpdating = Fals5
        For Each xCell In Selection
            Dim varWord As Variant
            For Each varWord In Split(xHStr, Space$(1))
                xHStrLen = Len(varWord)
                xArr = Split(LCase(xCell.Value), LCase(varWord))
                xCount = UBound(xArr)
                If xCount > 0 Then
                    xStrTmp = ""
                    For i = 0 To xCount - 1
                        xStrTmp = xStrTmp & xArr(i)
                        xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.ColorIndex = 3
                        xCell.Characters(Len(xStrTmp) + 1, xHStrLen).Font.Bold = True
                        xStrTmp = xStrTmp & varWord
                    Next
                End If
            Next varWord
        Next xCell
    Application.ScreenUpdating = True
End Sub

Thanks,
SC

 

[chingching831]

Nice!! This takes shorter time to highlight!

Sub testV2()
    Dim myList, e, i&, r As Range, x&, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    myList = Sheets("myList").[a1].CurrentRegion.Value
    For i = 1 To UBound(myList, 1)
        dic(myList(i, 1)) = myList(i, 2)
    Next
    With Selection
        .Font.Bold = False
        .Font.ColorIndex = xlAutomatic
        For Each r In .Cells
            For Each e In dic
                x = InStr(1, r, e, 1)
                Do While x
                    With r.Characters(x, Len(e)).Font
                        .ColorIndex = dic(e)
                        .Bold = True
                    End With
                    x = InStr(x + 1, r, e, 1)
                Loop
            Next
        Next
    End With
End Sub