Home > Net >  VBA, Error 400 - Delete Strikethrough Text
VBA, Error 400 - Delete Strikethrough Text

Time:10-28

I have the following Excel-vba code, which delets all strikethrough text:

Private Sub DelStrikethroughText()
    'Deletes strikethrough text in all selected cells
    Dim Cell        As Range
    For Each Cell In Selection
        DelStrikethroughs Cell
    Next Cell
End Sub

Private 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

The code itself works fine on a small selection of cells, however, selecting more than 10 or so cells results in an error 400.

My code always fails at the last cell of the first row (so it depends on my selection). So the macro is interrupted, just as it is supposed to change to row 2. The cursor stops at this line NewText = NewText & .Text But why is there a problem?

Any help would be appreciated. Why does Excel throw the error 400, what do I have to fix on my code?

Thanks for any help in advance.

CodePudding user response:

Cell.Characters.Text does not work for cells containing formulas, numbers, dates etc. you can use Mid() function instead, however this may convert existing numbers to text:

Private Sub DelStrikethroughText()
    'Deletes strikethrough text in all selected cells
    Dim Cell        As Range
    For Each Cell In Selection
        If Cell.NumberFormat = "General" Then DelStrikethroughs Cell
    Next Cell
End Sub

Private 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 & Mid(Cell, iCh, 1)
            End If
        End With
    Next iCh
    Cell.Value = NewText
    Cell.Characters.Font.Strikethrough = False
End Sub
  • Related