CODEWITHSUNDEEP
stringvbaexcelobject
Anastasiya-Romanova 秀
Anastasiya-Romanova 秀

Reputation: 3368

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

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

enter image description here

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

enter image description here

What is the correct way to get the output like the first picture?

Upvotes: 1

Views: 398

Answers (1)

Tim Williams
Tim Williams

Reputation: 166146

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

Upvotes: 2

Related Questions