Выделить часть текста цветом в ячейке по шаблону на всем листе(не пустые ячейки)

Sub tt()
    Dim arr(), Rng As Range, i As Long, j As Long, M As Object
    Set Rng = Selection
    arr = Rng
    With CreateObject("VBScript.Regexp")
        .Global = True
        .Pattern = InputBox("Введите шаблон")
        If .Pattern = "" Then Exit Sub
        For i = 1 To UBound(arr)
            If arr(i, 1) <> "" Then
                Set M = .Execute(arr(i, 1))
                If M.Count > 0 Then
                    For j = 0 To M.Count - 1
                        Rng(i).Characters(M(j).firstindex + 1, M(j).Length).Font.Color = vbRed
                    Next
                End If
            End If
        Next
    End With
End Sub

Sub tt()
    Dim arr(), Rng As Range, i As Long, j As Long, M As Object, n&
    Set Rng = Selection
    arr = Rng
    With CreateObject("VBScript.Regexp")
        .Global = True
        .IgnoreCase = True
        .Pattern = InputBox("Введите шаблон")
        If .Pattern = "" Then Exit Sub
        For i = 1 To UBound(arr)
            For n = 1 To UBound(arr, 2)
                If Not IsEmpty(arr(i, n)) Then
                    Set M = .Execute(arr(i, n))
                    If M.Count > 0 Then
                        For j = 0 To M.Count - 1
                            Rng.Cells(i, n).Characters(M(j).firstindex + 1, M(j).Length).Font.Color = vbRed
                        Next
                    End If
                End If
            Next
        Next
    End With
End Sub

Sub color()
    Dim arr(), Rng As Range, i As Long, j As Long, M As Object, n&
    Set Rng = ActiveSheet.UsedRange
    arr = Rng
    sFontColorAsk = InputBox("Введите один из цветов: " _
    & Chr(13) & "черный, красный, зеленый, желтый," _
    & Chr(13) & "синий, пурпурный, циан, белый")
    If sFontColorAsk = "черный" Or sFontColorAsk = "Черный" Then sFontColor = vbBlack
    If sFontColorAsk = "красный" Or sFontColorAsk = "Красный" Then sFontColor = vbRed
    If sFontColorAsk = "зеленый" Or sFontColorAsk = "Зеленый" Then sFontColor = vbGreen
    If sFontColorAsk = "желтый" Or sFontColorAsk = "Желтый" Then sFontColor = vbYellow
    If sFontColorAsk = "синий" Or sFontColorAsk = "Синий" Then sFontColor = vbBlue
    If sFontColorAsk = "пурпурный" Or sFontColorAsk = "Пурпурный" Then sFontColor = vbMagenta
    If sFontColorAsk = "циан" Or sFontColorAsk = "Циан" Then sFontColor = vbCyan
    If sFontColorAsk = "белый" Or sFontColorAsk = "Белый" Then sFontColor = vbWhite
    With CreateObject("VBScript.Regexp")
        .Global = True
        .IgnoreCase = True
        .Pattern = InputBox("Введите что окрасить")
        If .Pattern = "" Then Exit Sub
        For i = 1 To UBound(arr)
            For n = 1 To UBound(arr, 2)
                If Not IsEmpty(arr(i, n)) Then
                    Set M = .Execute(arr(i, n))
                    If M.Count > 0 Then
                        For j = 0 To M.Count - 1
                            Rng.Cells(i, n).Characters(M(j).firstindex + 1, M(j).Length).Font.Color = sFontColor 'vbRed
                        Next
                    End If
                End If
            Next
        Next
    End With
End Sub