Need to remove text with strikethrough - Excel 2007

[HD]

I 'inherited' a large spreadsheet where every cell contains free form
text. A single cell can contain text with strikethroughs and plain
text (no strikethroughs). I need to create some VBA to delete only the
text with strikethroughs and leave the plain text within each cell.
I'm not worried about speed.
Does anyone have any ideas?

 

[Jarek Kujawa]

try:

Sub znajdz()

On Error Resume Next

For Each Cell In Selection
counter = 0
For i = 1 To Len(Cell)
If Cell.Characters(Start:=i - counter,
Length:=1).Font.Strikethrough Then
Cell.Characters(Start:=i - counter, Length:=1).Delete
If Cell.Characters(Start:=i - counter, Length:=2) =
Chr(32) & Chr(32) Then
Cell.Characters(Start:=i - counter,
Length:=2).Delete
End If
counter = counter + 1
End If
Next i
Next Cell
End Sub

this will leave you with double spaces somewhere
you may get rid of them by using CTRL+H (Edit->Replace)

HIH

 

[John C]

If this is just a 1 time thing, you don't need a macro, just select the
entire sheet, go to Format-->Cells, the Font tab, the Strikethrough box
should be gray, showing some cells have it, some don't, click it twice, the
first time, the checkbox will still be checked but white (if left here, your
entire spreadsheet would have strikethrough), check it again, and it will
ensure all data on spreadsheet has no strikethrough.

 

[John C]

whooops!, nevermind, i just re-read your post

 

[Rick Rothstein \(MVP - VB\)]

Give this a try...

Sub RemoveStrikeThruText()
Dim X As Long
Dim C As Range
For Each C In Selection
For X = Len(C.Value) To 1 Step -1
If C.Characters(X, 1).Font.Strikethrough Then
C.Characters(X, 1).Delete
End If
Next
C.Value = Application.WorksheetFunction.Trim(C.Value)
Next
End Sub

Note that it cleans up **all** multiple spaces in the text string, including
any that were there before it was run. If that is not acceptable, post back
and let us know.

Rick

 

[HD]

try:

Sub znajdz()

On Error Resume Next

For Each Cell In Selection
counter = 0
    For i = 1 To Len(Cell)
        If Cell.Characters(Start:=i - counter,
Length:=1).Font.Strikethrough Then
            Cell.Characters(Start:=i - counter, Length:=1).Delete
                If Cell.Characters(Start:=i - counter, Length:=2) =
Chr(32) & Chr(32) Then
                    Cell.Characters(Start:=i - counter,
Length:=2).Delete
                End If
            counter = counter + 1
        End If
    Next i
Next Cell
End Sub

this will leave you with double spaces somewhere
you may get rid of them by using CTRL+H (Edit->Replace)

HIH

Wonderfully straightforward solution! Works great! Thanks!

 

[Jarek Kujawa]

thks but Rick's is better...