Delete strikethrough cells and iterate through all sheets

Question

I'm trying to delete all cells with strikethrough from a Workbook and iterate on all sheets at the same time.

I have followed this, this and this and come up with two macros, but they are not working. This is the first time that I use VBA so I'm not sure of how to fix these problems.

Sub DeleteCells()
Dim Cell As Range, iCh As Integer, NewText As String
Dim WS_Count As Integer
         Dim I As Integer

         ' Set WS_Count equal to the number of worksheets in the active
         ' workbook.
         WS_Count = ActiveWorkbook.Worksheets.Count

         ' Begin the loop.
         For I = 1 To WS_Count

With Sheets(I) ' <~~ avoid select as much as possible, work directly with the objects

    Lrow = .Cells(.Rows.Count, "C").End(xlUp).Row
    For Each Cell In .Range("C1:M" & Lrow)
        For iCh = 1 To Len(Cell)
             With Cell.Characters(iCh, 1)
                 If .Font.Strikethrough = False Then NewText = NewText & .Text
            End With
        Next iCh
        Cell.Value = NewText ' <~~ You were doing it the other way around
        NewText = "" ' <~~ reset it for the next iteration
        Cell.Characters.Font.Strikethrough = False
    Next Cell
End With
Next I
End Sub

In this case I get "Unable to get the Text property of the Character class"

Sub LoopThroughAllTablesinWorkbook()

    Dim tbl As ListObject
    Dim sht As Worksheet

    For Each sht In ThisWorkbook.Worksheets

   With Sheets("sht")

    Lrow = .Cells(.Rows.Count, "C").End(xlUp).Row
    For Each Cell In .Range("C1:M" & Lrow)
        For iCh = 1 To Len(Cell)
             With Cell.Characters(iCh, 1)
                 If .Font.Strikethrough = False Then NewText = NewText & .Text
            End With
        Next iCh
        Cell.Value = NewText ' <~~ You were doing it the other way around
        NewText = "" ' <~~ reset it for the next iteration
        Cell.Characters.Font.Strikethrough = False
    Next Cell
    End With
    Next sht





End Sub

In this case I get as an error: Subscript out of range, which refers to the With Sheets part.

score 2 · Accepted Answer · answered Sep 22 '17 at 11:01

Try this

Sub DeleteCells()
    Dim cel As Range
    Dim ws As Worksheet
    Dim lastRow As Long

    For Each ws In ActiveWorkbook.Worksheets    'loop through all sheets
        With ws
            lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row    'get last row with data using Column C
            For Each cel In .Range("C1:M" & lastRow)    'loop through all cells in range
                If cel.Font.Strikethrough Then          'check if cell has strikethrough property
                    cel.Clear                           'make cell blank and remove strikethrough property
                End If
            Next cel
        End With
    Next ws
End Sub

Delete strikethrough cells and iterate through all sheets

1 Answers1

Linked