VBA code for deleting strike-through text - I'm in ''loop & freeze'' hell

[Alegria]

Hi guys,

I guess I have a slightly silly question, but I am not too advanced with VBA, so bare with me
I have a data set with text in column C, which contains striked words at random places within the paragraphs. What I need to do is to fully delete those strike-through phrases (without replacing them with normal text).
I was able to find online the following script, which I plugged into a form control and it seems to do the trick, but the problem is that for some reason it loops and processes forever and I end up having to disrupt the macro manually every time so that the workbook becomes functional again.. I thought setting a range would narrow down the processing and fix the issue (there is no data after C70, but the range varies as it is not a fixed ending point, so I just took cell C70 as potentially the furthest possible value) but it does not.. What am I doing wrong? I have searched so much about loop avoidance and what not and I tried to implement all of that, but I guess I just need a little help here.

Sub DeleteStrikedText()
'Application.ScreenUpdating = False
'Deletes strikethrough text in all selected cells
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim Cell As Range
For Each Cell In Range(Range("C4:C70"), Selection.SpecialCells(xlLastCell))
DelStrikethroughs Cell
Next
'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
On Error GoTo 999
NewText = NewText & .Text
End If
End With
Next iCh
Cell.Value = NewText
Cell.Characters.Font.Strikethrough = False
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
999 End Sub

 

[onlyadrafter]

Hello,

Does this work as expected?

Sub DELETE_STRIKETHROUGH()
    For MY_ROWS = 1 To Range("C" & Rows.Count).End(xlUp).Row
        For MY_CELLS = 1 To Len(Range("C" & MY_ROWS).Value)
            With Range("C" & MY_ROWS).Characters(Start:=MY_CELLS, Length:=1).Font
               If .Strikethrough = False Then
                    MY_WORD = MY_WORD & Mid(Range("C" & MY_ROWS).Value, MY_CELLS, 1)
                End If
            End With
        Next MY_CELLS
        Range("C" & MY_ROWS).Value = MY_WORD
        MY_WORD = ""
    Next MY_ROWS
End Sub

or to amend your code

Sub DeleteStrikedText()
'Application.ScreenUpdating = False
'Deletes strikethrough text in all selected cells
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim Cell As Range
For Each Cell In Range(Range("C4:C" & Range("C" & Rows.Count).End(xlUp).Row), Selection.SpecialCells(xlLastCell))
DelStrikethroughs Cell
Next
'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
On Error GoTo 999
NewText = NewText & .Text
End If
End With
Next iCh
Cell.Value = NewText
Cell.Characters.Font.Strikethrough = False
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
999 End Sub

I don't have an error with this code.

 

[Alegria]

Wow, onlyadrafter , you are a life-saviour! The first one works like a charm
Thank you so much for the fast and helpful reply! You sure saved me a lot of hassle. Cheers!