Change the last letter in a cell to match background

[Exclove]

Greeting to all and thank you do much for any help you can provide. I am new into VBA and I am trying to resolve the following need. I have 2 Ranges C10:AQ26 & C34:AQ50. I want to change the font color of the last letter so it becomes invisible. What I mean, I need the font for the letter to match the background of the cell.

• If cell = 0 then Font= White ; Fill= white
• If Cell is Number + X then Number= Dark Blue, Letter X = Light Blue ; Fill= Light Blue
• If Cell is Number + E then Number= Dark Green, Letter E = Light Green ; Fill= Light Green
• If Cell is Number + B then Number= Dark Red, Letter B = Pink ; Fill= Pink

I I was able to tweak the below code but it has 2 limitations:

1. It's extremely slow
2. I doesn't allow me to match the fill color to the last letter color.

Sub Color_Part_of_Cell_1()
Dim r As Range
For Each r In Range("C10:AQ26")
r.Characters(InStrRev(r.Value, " ") + 1, 8).Font.Size = 1 ' the font change is optional
r.Characters(InStrRev(r.Value, " ") + 1, 8).Font.Color = RGB(217, 245, 242)
Next r
End Sub
---------------------------------------------------------------------------------------------
Sub Color_Part_of_Cell_2()
Dim r As Range
For Each r In Range("C34:AQ50")
r.Characters(InStrRev(r.Value, " ") + 1, 8).Font.Size = 1 ' the font change is optional
r.Characters(InStrRev(r.Value, " ") + 1, 8).Font.Color = RGB(217, 245, 242)
Next r
End Sub

 

[Anthony47]

Formatting need to be done cell by cell and will be slow, and you had already experienced this.
Is it ok for your application replacing the content of the cell (ie removing the last X, E, B from the text)? That would be much faster

 

[Exclove]

Formatting need to be done cell by cell and will be slow, and you had already experienced this.
Is it ok for your application replacing the content of the cell (ie removing the last X, E, B from the text)? That would be much faster

Thank you Anthony for your reply.

Yes, it's OK to remove the Letters (X,E, B,...) as long as (1) these numbers will be distinguishable (maybe with some conditional formatting) and (2) I can sum each group of numbers ( sum of all numbers ending with x, sum of all numbers ending with E, etc.).

Again, thank you for any help that you can provide!

 

[Anthony47]

If we remove those characthers you will no longer be able to check for their past presence, unless you use a shadow copy of the original datas.

But we could replace the last characters with non displayable ones, for example ascii chars 28 to 32

We can do that with the following macro:

Sub ForXL()
Dim wArr, BadChr, RepChr, Blks
Dim I As Long, J As Long, K As Long, L As Long
'
BadChr = Array("X", "E", "B")           '<<< Characters to be replaced
Blks = Array("C10:AQ26", "C34:AQ50")    '<<< Range to look in
RepChr = Array(28, 29, 30, 31, 32)      '<<< Replacement Char-code
'
For I = 0 To UBound(Blks)
    wArr = Range(Blks(I)).Value
    For J = 1 To UBound(wArr)
        For K = 1 To UBound(wArr, 2)
            For L = 0 To UBound(BadChr)
                If UCase(Right(" " & wArr(J, K), 1)) = BadChr(L) Then
                    Mid(wArr(J, K), Len(wArr(J, K)), 1) = Chr(RepChr(L))
                    Exit For
                End If
            Next L
        Next K
    Next J
    Range(Blks(I)).Value = wArr
Next I
End Sub

The lines marked <<< should be customized according the comment
Namely BadChr is the list of the characters to be replaced, in UpperCase (but both LCase and UCase will be replaced), and RepChr is the list of replacement codes to be used. The BadChr list can be updated up to 5 characters without the need for updating RepChr, that already lists 5 replacement codes

At the end of the macro, X will be replaced by CHAR(28), E by CHAR(29) and B by CHAR(30); keep in mind these replacemments when now you look for "X" or E or B ending string

Of course you will test the macro on a copy of your real data...