VBA to Clear texts with Strikethroughs, Red fonts and semicolons in cells (selection)

[alishern]

Hi,

I have a large excel file that I receive from the users with comments. The comments include texts with strikethroughs in red fonts that need to be removed - basically, the text with strikethroughs (and sometimes in red fonts) are obsolete and need to be removed. I need to be able to remove the texts with strikethroughs inside each cell in a selected range. Here are a few examples:

Example 1 - the result does not need to retain the original formatting (blue font in this case)
View attachment 99109

Example 2

Dug up a few codes (see below), but it throws this error. As usual, thank you in advance.

Error:

Sub DelStrikethroughText()
  
   Application.ScreenUpdating = False
    
   'Deletes strikethrough text in all selected cells
   Dim Cell    As Range
  
   For Each Cell In Selection
      DelStrikethroughs Cell
   Next Cell
  
   'remove removeSemiCol texts
   Selection.replace What:=";", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2

        
   Application.ScreenUpdating = True
  
End Sub

Sub DelStrikethroughs(Cell As Range)
   'deletes all strikethrough text in the Cell
   Dim NewText    As String
   Dim iCh        As Integer
   For iCh = 1 To Len(Cell)
      With Cell.Characters(iCh, 1)
         If .Font.Strikethrough = False Then
            NewText = NewText & .Text
         End If
      End With
   Next iCh
   Cell.Value = NewText
   Cell.Characters.Font.Strikethrough = False
End Sub

 

[alishern]

Example 1 attachment

 

[Akuini]

I have a large excel file that I receive from the users with comments.

About how many rows is it?
It would be easier & faster if you delete texts with strikethroughs & text in red in Word. So, copy paste the table to Word.
Open replace dialog box.
Click Format > Font > Strikethrough > OK > Replace All
Click No Formatting > Format > Font > Font color > Red color > OK > Replace All
Copy back table to Excel.

 

[alishern]

About how many rows is it?
It would be easier & faster if you delete texts with strikethroughs & text in red in Word. So, copy paste the table to Word.
Open replace dialog box.
Click Format > Font > Strikethrough > OK > Replace All
Click No Formatting > Format > Font > Font color > Red color > OK > Replace All
Copy back table to Excel.

It is a large file and i want to do it in excel. This will be a repetitive effort and i need to automate it.

 

[Akuini]

It is a large file and i want to do it in excel. This will be a repetitive effort and i need to automate it.

Sorry, I don't know how to do it in Excel.
Hopefully somebody will be able to help.

 

[kevin9999]

Please try the following on a copy of your worksheet:

Option Explicit
Sub Clear_Red_Strikethrough()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")       '<-- *** Change to actual sheet name ***
    Dim r As Range, c As Range, i As Long, j As Long
    
    For Each c In ws.Range("A2", Cells(Rows.Count, "A").End(xlUp))
        For i = 1 To Len(c)
            If c.Characters(i, 1).Font.Color = vbRed Or _
                c.Characters.Font.Strikethrough = True Then
                j = j + 1
            End If
        Next i
        If j > 0 Then
            c.Offset(, 1) = Right(c, Len(c) - j)
        Else
            c.Offset(, 1) = c
        End If
        j = 0
    Next c
    Application.ScreenUpdating = True
End Sub

 

[kevin9999]

Amended code to include semicolons that are neither red nor strikethrough.

Option Explicit
Sub Clear_Red_Strikethrough_Semicolon()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")       '<-- *** Change to actual sheet name ***
    Dim r As Range, c As Range, i As Long, j As Long
    
    For Each c In ws.Range("A2", Cells(Rows.Count, "A").End(xlUp))
        For i = 1 To Len(c)
            If c.Characters(i, 1).Font.Color = vbRed Or _
                c.Characters.Font.Strikethrough = True Or _
                Mid(c, i, 1) = ";" Then
                j = j + 1
            End If
        Next i
        If j > 0 Then
            c.Offset(, 1) = Right(c, Len(c) - j)
        Else
            c.Offset(, 1) = c
        End If
        j = 0
    Next c
    Application.ScreenUpdating = True
End Sub

 

[alishern]

Amended code to include semicolons that are neither red nor strikethrough.

Option Explicit
Sub Clear_Red_Strikethrough_Semicolon()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")       '<-- *** Change to actual sheet name ***
    Dim r As Range, c As Range, i As Long, j As Long
   
    For Each c In ws.Range("A2", Cells(Rows.Count, "A").End(xlUp))
        For i = 1 To Len(c)
            If c.Characters(i, 1).Font.Color = vbRed Or _
                c.Characters.Font.Strikethrough = True Or _
                Mid(c, i, 1) = ";" Then
                j = j + 1
            End If
        Next i
        If j > 0 Then
            c.Offset(, 1) = Right(c, Len(c) - j)
        Else
            c.Offset(, 1) = c
        End If
        j = 0
    Next c
    Application.ScreenUpdating = True
End Sub

Kevin,

First off, thank you. Here is what I am getting: - Column C is my comments. Looks like it works fine on the numbers, but for mix strings it is not showing the expected result.

 

[kevin9999]

Please try the following on a copy of your workbook:

Option Explicit
Sub Clear_Red_Strikethrough_Semicolon_V2()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")       '<-- *** Change to actual sheet name ***
    Dim r As Range, c As Range, i As Long
    
    For Each c In ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))
        c.Copy c.Offset(, 1)
        Set r = c.Offset(, 1)
        For i = Len(r.Text) To 1 Step -1
            If r.Characters(i, 1).Font.Color = vbRed Or _
                r.Characters.Font.Strikethrough = True Or _
                Mid(r, i, 1) = ";" Then
                If i > 1 And i < Len(r) Then
                    r.Characters(i, 1).Text = ""
                Else
                    r = ""
                End If
            End If
        Next i
    Next c
    Application.ScreenUpdating = True
End Sub

If you wanted column A to return the result, try this:

Option Explicit
Sub Clear_RSS_In_Situ()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")       '<-- *** Change to actual sheet name ***
    Dim c As Range, i As Long
    
    For Each c In ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp))
        For i = Len(c.Text) To 1 Step -1
            If c.Characters(i, 1).Font.Color = vbRed Or _
                c.Characters.Font.Strikethrough = True Or _
                Mid(c, i, 1) = ";" Then
                If i > 1 And i < Len(c) Then
                    c.Characters(i, 1).Text = ""
                Else
                    c = ""
                End If
            End If
        Next i
    Next c
    Application.ScreenUpdating = True
End Sub

 

[kevin9999]

Ignore the code in post #9. I'll need to revise it, leave it with me.