How to change font colour on Variant excel VBA?

Question

I have some code that takes a cell value such as <0.2 and discards the 'less than' symbol and returns half the numeric portion eg 0.1

This works well but I want to indicate the cells that have been changed by making the font colour red.

I can't get the formatting applied. I have tried a few variations on the code below but get a run-time error 424 object required, on the formatting line. MyVar = MyVar.Font.ColorIndex = 3

Sub RemoveLessThanSpedUp()
'
'
'Values with Red Text were reported as less than the method detection limit and are shown here as one-half the detection limit
'
Dim r As Range
Dim Datarange As Variant
Dim Irow As Integer
Dim MaxRows As Long
Dim Icol As Integer
Dim MaxCols As Long
Dim MyVar As Variant

Datarange = Range("A1").CurrentRegion.Value
MaxRows = Range("A1").CurrentRegion.Rows.Count
MaxCols = Range("A1").CurrentRegion.Columns.Count
    For Irow = 1 To MaxRows
        For Icol = 1 To MaxCols
            MyVar = Datarange(Irow, Icol)
            If Left(MyVar, 1) = "<" Then
            MyVar = (Right(MyVar, Len(MyVar) - 1)) / 2
            MyVar = MyVar.Characters.ColorIndex = 3
            'MyVar.Font.ColorIndex = 3
            Datarange(Irow, Icol) = MyVar
            
            End If
        
    Next Icol
    Next Irow
Range("A1").CurrentRegion = Datarange
End Sub```

Answer 1

Try the next adapted code, please. Your code uses an array, which is not bad in terms of speed, but it does not handle ranges which have a font property. Coloring many cells may take a lot of time. I will build an array to be filled with the modified cells address, which will be dropped on the first column after the existing one:

Sub RemoveLessThanSpedUp()
Dim r As Range, Datarange As Variant, Irow As Integer
Dim MaxCols As Long, MyVar As Variant, MaxRows As Long, Icol As Long
Dim sh As Worksheet, i As Long, arrEr, k As Long

Set sh = ActiveSheet 'use here what you need

MaxRows = sh.Range("A1").CurrentRegion.Rows.Count
MaxCols = sh.Range("A1").CurrentRegion.Columns.Count
If sh.Cells(1, MaxCols).Value = "Errors" Then
    sh.Cells(1, MaxCols).EntireColumn.Clear
    MaxCols = MaxCols - 1
End If
Datarange = sh.Range("A1").CurrentRegion.Value
ReDim arrEr(MaxRows * MaxCols)
    For Irow = 1 To MaxRows
        For Icol = 1 To MaxCols
            i = i + 1
            MyVar = Datarange(Irow, Icol)
            If Left(MyVar, 1) = "<" Then
                MyVar = (Right(MyVar, Len(MyVar) - 1)) / 2
                arrEr(k) = sh.Cells(Irow, Icol).Address(0, 0): k = k + 1
                Datarange(Irow, Icol) = MyVar
            End If
        Next Icol
    Next Irow
    
    If k > 0 Then
        ReDim Preserve arrEr(k - 1)
        sh.Range("A1").CurrentRegion = Datarange
        With sh.Cells(2, MaxCols + 1)
            .Offset(-1).Value = "Errors"
            .Resize(k, 1).Value = Application.Transpose(arrEr)
        End With
    Else
        MsgBox "Nothing to be corrected..."
    End If
End Sub