Range.Characters object doesn't work as expected in a loop - string

Question

Below is a program in Excel VBA that creates a progress indicator. I've tried to make the progress indicator as simple as possible, yet it still looks elegant by using Unicode characters: full block and thin space.
Private Sub Play_Click()
Dim iCounter As Long, iRow As Long, nRow As Long, _
Block As String, Progress As Long, iChar As Long
Columns(1).ClearContents
With Cells(2, 4)
.ClearContents
.Font.Color = vbBlue
nRow = 100
For iRow = 1 To nRow
For iCounter = 1 To 100
Cells(iRow, 1) = iCounter
Next
Progress = Int(iRow / 10)
If Progress = iRow / 10 Then
Block = Block & ChrW(9608) & ChrW(8201)
'------------------
'Option statements
'------------------
End If
.Value = Block & " " & iRow & " %"
Next
End With
End Sub
I'd like to have the progress indicator looks like this
where the full blocks are always green-colored and the percentage number is always blue-colored while the program is running. But using these three option statements,
Option 1
.Characters(, 2 * Progress - 1).Font.Color = vbGreen
Option 2
For iChar = 1 To Len(.Value)
If Mid$(Text, iChar, 1) = ChrW(9608) Then
.Characters(iChar, 1).Font.Color = vbGreen
End If
Next
Option 3
GreenBlue 2 * Progress - 1
---------------------
Sub GreenBlue(GreenPart As Integer)
Select Case GreenPart
Case 1 To 19
Cells(2, 4).Characters(, GreenPart).Font.Color = vbGreen
End Select
End Sub
I kept getting the following output
What is the correct way to get the output like the first picture?

Answer 1

Whenever you replace the value of the cell, all of the new content will pick up its formatting from the first character being replaced, so the whole content will be green: need to first set the color back to blue if you want the numeric part to be blue
Private Sub Play_Click()
Dim iCounter As Long, iRow As Long, nRow As Long, _
Block As String, Progress As Long, iChar As Long, x As Long
Columns(1).ClearContents
With Cells(2, 4)
.ClearContents
.Font.Color = vbBlue
nRow = 100
For iRow = 1 To nRow
For iCounter = 1 To 100
Cells(iRow, 1) = iCounter
Next
Progress = Int(iRow / 10)
If Progress = iRow / 10 Then
Block = Block & ChrW(9608) & ChrW(8201)
End If
Application.ScreenUpdating = False 'reduce flashing during update
.Value = Block & " " & iRow & " %"
.Font.Color = vbBlue
If Len(Block) > 0 Then
.Characters(1, InStr(.Value, " ")).Font.Color = vbGreen
End If
Application.ScreenUpdating = True
'add some delay...
For x = 1 To 1000
DoEvents
Next x
Next
End With
End Sub