delete text within a cell which is a specific color and retain formatting of the remaining text

[Ogungen]

Hi - i've written following code which is intended to delete all text in cells within a range which are in a specific color. It does indeed delete the text of the specified color - however the formatting of the remaining text is altered / not maintained. Would you have any advice?

e.g. "are you opened open on sunday?" should become: "are you open on sunday?"

Code>>>>

Sub deletecolor()
Dim rng As Range, sTemp As String, ct As Long
Set rng = Range("A1:A10")
For Each c In rng
ct = 0
sTemp = vbNullString
For i = Len(c.Text) To 1 Step -1
If c.Characters(i, 1).Font.Color = RGB(0,0,0) Then
ct = ct + 1
If ct = 1 Then
sTemp = WorksheetFunction.Replace(c.Text, i, 1, "")
Else
sTemp = WorksheetFunction.Replace(sTemp, i, 1, "")
End If
End If
Next i
If ct > 0 Then c.Value = sTemp
Next c
End Sub

 

[Peter_SSs]

Welcome to the MrExcel board!

Your descriptions and code do not seem to match. You say you want to delete text of a "specific color". From your expected results it would appear that the color to delete is red as your expected result retains the green text.

You also say your code deletes the specified color text, implying that the only problem is the color of the remaining text. However, my testing shows that the existing code deletes both the red (opened) and the green (open) text.

Assuming that what you want to do is delete the red text only and keep the rest, including green, try this in a copy of your workbook.

Note that it only tries to replicate font colour and any underlining. If you want more (eg Bold) you would need to add extra dimensions to the array aCol and collect and re-write that info by expanding the relevant sections of the code. Post back with more details if you want to do that and need help.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> deletecolor_v2()<br>  <SPAN style="color:#00007F">Dim</SPAN> rng <SPAN style="color:#00007F">As</SPAN> Range, c <SPAN style="color:#00007F">As</SPAN> Range<br>  <SPAN style="color:#00007F">Dim</SPAN> s <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, sTemp <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>  <SPAN style="color:#00007F">Dim</SPAN> aCol<br>  <SPAN style="color:#00007F">Dim</SPAN> p <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, k <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, L <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>  <br>  <SPAN style="color:#00007F">Set</SPAN> rng = Range("A1:A10")<br>  <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> rng<br>    s = c.Value<br>    L = Len(s)<br>    <SPAN style="color:#00007F">If</SPAN> L > 0 <SPAN style="color:#00007F">Then</SPAN><br>      k = 0<br>      sTemp = vbNullString<br>      <SPAN style="color:#00007F">ReDim</SPAN> aCol(1 <SPAN style="color:#00007F">To</SPAN> L, 1 <SPAN style="color:#00007F">To</SPAN> 2)<br>      <SPAN style="color:#00007F">For</SPAN> p = 1 <SPAN style="color:#00007F">To</SPAN> L<br>        <SPAN style="color:#00007F">If</SPAN> c.Characters(p, 1).Font.Color <> vbRed <SPAN style="color:#00007F">Then</SPAN><br>          k = k + 1<br>          aCol(k, 1) = c.Characters(p, 1).Font.Color<br>          aCol(k, 2) = c.Characters(p, 1).Font.Underline<br>          sTemp = sTemp & Mid(s, p, 1)<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>      <SPAN style="color:#00007F">Next</SPAN> p<br>      c.Value = sTemp<br>      <SPAN style="color:#00007F">For</SPAN> p = 1 <SPAN style="color:#00007F">To</SPAN> k<br>        c.Characters(p, 1).Font.Color = aCol(p, 1)<br>        c.Characters(p, 1).Font.Underline = aCol(p, 2)<br>      <SPAN style="color:#00007F">Next</SPAN> p<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>  <SPAN style="color:#00007F">Next</SPAN> c<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[Ogungen]

Peter! thank you very much for your kind help - this has indeed solved my problem - a big thank you from my wife!!!

brgds,

Osman

 

[Andrew Poulsom]

Another possibility using the Characters' Delete method:

Sub deletecolor()
    Dim rng As Range
    Dim c As Range
    Dim i As Long
    Set rng = Range("A1:A10")
    For Each c In rng
        For i = Len(c.Text) To 1 Step -1
            With c.Characters(i, 1)
                If .Font.ColorIndex = 3 Then
                    .Delete
                End If
            End With
        Next i
    Next c
End Sub

 

[Peter_SSs]

Another possibility using the Characters' Delete method:

So simple and Direct Andrew.