Remove Strikethrough and delete red text.

[Mini-Travis]

Good afternoon,

I am having trouble coming up with the code I need to complete a particular task.
Background: I created vba code that would go through a range of cells and remove strikethrough text and turn red text black. This works perfectly for that particular task.
Code:
For Each c In MyRange
OldText = c.Text
For iCh = 1 To Len(c)
With c.Characters(iCh, 1)
If .Font.Strikethrough = True Then
BadText = BadText & .Text
End If
End With
Next iCh
NewText = Replace(OldText, BadText, blankText)

c.Value = NewText
c.Characters.Font.Strikethrough = False
c.Characters.Font.Color = RGB(0, 0, 0)
Problem: I am trying to figure out how to do the exact opposite of what this code currently does. For Example, if a cell has text that is stuckthrough I would like to remove the strikethrough property and turn the text black. Then i would like to go through the range a second time looking for text that is red. When this text is found, I would like to delete that particular string.

I hope I was able to explain the problem in the level of detail needed to aquire a solution.

 

[JoeMo]

Try this (adjust range to suit):

Sub AlterText()
Dim rng As Range
Set rng = Range("A1:A10")  'Adjust to suit
For Each c In rng
    For i = 1 To Len(c.Text)
        If c.Characters(i, 1).Font.Strikethrough = True Then
           c.Characters(i, 1).Font.Strikethrough = False
        End If
    Next i
Next c
For Each c In rng
    For i = 1 To Len(c.Text)
        If c.Characters(i, 1).Font.Color = vbRed Then
            c.ClearContents
            Exit For
        End If
    Next i
Next c
End Sub

 

[Mini-Travis]

JoeMo,

Thank you for helping me. The strikethrough works fine, but for some reason the text that was not strikethrough became strikethrough. I corrected this by just making the strikethrough for the cell false before moving to the next cell.

It is still having an issue with the deletion of the red text. I set the range to only a few cells for testing, range = A1:A4. After going through the first cell, which contains no red text, the code locks and I have to force excel to close. I tried to modify the code to this *I am not sure how to add the code as you have added it but here is a copy paste*

Code:
Sub AlterText()
Dim rng As Range
Set rng = Range("A1:A4") 'Adjust to suit
For Each c In rng
For i = 1 To Len(c.Text)
If c.Characters(i, 1).Font.Strikethrough = True Then
c.Characters(i, 1).Font.Strikethrough = False
End If
Next i
c.Font.Strikethrough = False
Next c
For Each c In rng
For i = 1 To Len(c.Text)
If c.Characters(i, 1).Font.Color = RGB(255, 0, 0) Then
c.ClearContents
Exit For
End If
'This just loops through and does not notice that the color is red or black.
Next i
Next c
End Sub

I did find that I could do this:

If c.Characters(i, 1).Font.Color <> RGB(0, 0, 0) Then
c.ClearContents
Exit For
End If

But i really only want to delete the single character that is red instead of the entire cell contents. So I modified the the code to look like this:

If c.Characters(i, 1).Font.Color <> RGB(0, 0, 0) Then
c.Characters(i,1).ClearContents
Exit For
End If

But I got a runtime error of Object does not support property or method.
Do you know how i could fix this?

 

[JoeMo]

The code below will do the following: (1) remove strikethrough from any text in the designated range and make that text black, and (2) delete any text characters that have red font. Adjust the range to suit.

Sub AlterText()
Dim rng As Range, sTemp As String, ct As Long
Set rng = Range("A1:A10")  'Adjust range to suit
For Each c In rng
    For i = 1 To Len(c.Text)
        If c.Characters(i, 1).Font.Strikethrough = True Then
           c.Characters(i, 1).Font.Strikethrough = False
           c.Characters(i, 1).Font.Color = vbBlack
        End If
    Next i
Next c
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 = vbRed 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

 

[Mini-Travis]

I also tried the following code. It appears that it will do exactly what I am trying to accomplish, but still not functioning correctly. I find myself with two problems using this code.
1. If I have strikethrough text followed by nonstrikethrough text in a cell, (for the sake of showing I will use the 'Underline & Red' as strikethrough)
IN cell A4
7465
7895
My code will give the following result
7
It does this because (After Stepping through several times) I realize that when it deletes the strikethrough for the first character it deletes it for the entire cell. ??????? I am telling it to only delete for the first character. (Strange)
2. I keep getting an error code:
The object invoked has disconnected from its clients.
I am not sure how I was able to pull this off?

Sub AlterText()
Dim NewText, OldText, BlankText As String
Dim KillAudio
Dim rng As Range
Set rng = Range("A1:A7")  'Adjust to suit
For Each c In rng
    For i = 1 To Len(c.Text)
        If c.Characters(i, 1).Font.Strikethrough = True Then
           c.Characters(i, 1).Font.Strikethrough = False
           c.Characters(i, 1).Font.Color = RGB(0, 0, 0)
       End If
    Next i
    c.Font.Strikethrough = False
Next c
For Each c In rng
OldText = c.Text
BlankText = ""
    For i = 1 To Len(c.Text)
        If c.Characters(i, 1).Font.Color <> RGB(0, 0, 0) Then
           KillAudio = KillAudio & c.Characters(i, 1).Text
        End If
 
    Next i
    NewText = Replace(OldText, KillAudio, BlankText)
    c.Value = NewText
    KillAudio = ""
    NewText = ""
    c.Font.Color = RGB(0, 0, 0)
Next c
End Sub

 

[Mini-Travis]

JoeMo,

Thank you the code you provided works very well and also caused me to change how I deleted my strikethroughs in another code. (Your way was more efficient). I found out that it was my spreadsheet that caused the error. (Or atleast the way I had the data arranged in the cells)

2. I keep getting an error code:
The object invoked has disconnected from its clients.