Finding strikethrough text and deleting

[charliea]

I have a 8 columns of text and 3000 rows. Some of the text in the columns are formatted with the "Strikethrough" effect.

Wondering if it is possible to identify and remove this struckthrough text automatically ?

 

[Andrew Poulsom]

Select all the cells, right click, choose Format Cells and uncheck Strikethrough on the Font tab.

If you want a macro record your actions.

 

[WonLee]

When you type remove the strike through text...

Do you mean delete the whole contents of the cell?

OR

Remove the strike through effect?

 

[charliea]

Apologies I mean delete the text that is strikethrough and leave the text that is not strikethrough

 

[WonLee]

All the text in the cell is strikethrough or just a portion?

 

[charliea]

Either. if possible

 

[Damon Ostrander]

Del strikethrough text

Hi Charliea,

Here is a simple VBA macro that should do the trick. Simply select the cells you want to remove the strikethru text from, then run the DelStrikethroughText macro.

Here's the code:

Sub DelStrikethroughText()
   'Deletes strikethrough text in all selected cells
   Dim Cell    As Range
   For Each Cell In Selection
      DelStrikethroughs Cell
   Next Cell
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

If you don't already know how to install a custom VBA
macro or function in your workbook, here's how:

1) Go to the Visual Basic Editor (VBE) using the menu
Tools -> Macros -> Visual Basic Editor.

2) In the VBE, use the Insert -> Module menu to add
a module to your workbook's VBA project.

3) An empty code window pane will appear in the upper
right portion of the VBE. Paste the code you want
to install here. You can insert multiple Sub and/
or Function macros in this pane in the same module.

4) These macros will immediately become available for
use in the Workbook within which they have been
copied. To run the macro, go to Tools > Macro >
Macros... > select the macro and Run. You can also
assign the macro to a commandbutton or custom
toolbar button.

 

[Doug Keely]

I'm new to VBA Programming and come form a BASIC and then JAVA background. This code works, but I welcome any advice on better ways to do things.

'Remove Selected Strikes
'
'by Douglas Keely
'
'The purpose of this software is to edit out the redlined text
' This invloves several steps, that when automated save a few seconds per cell. Over
' time however, can save an enormous amount of time.
'
'The discreet steps the program performs are as follows:
' The routine changes numerical data back to numbers, and dates back to dates
'that have been inadvertently changed to text as a result of editing the cell data

Option Explicit
Dim totalRows, totalColumns, startRow, startColumn, c, r, i As Integer
Dim cellValue As Double
Dim cellValue2 As String

Sub remSelectedStrikes()

With ActiveSheet
With Selection

'Stores the total number or rows the user has selected.
totalRows = Selection.Rows.Count

'Asks the user to select a more discreeet set if they have tried to
' run the program on the entire sheet.
If (totalRows >= 65536) Or (totalColumns >= 256) Then
MsgBox ("Please do not select the entire sheet for this untility.")
Exit Function
End If

'Stores the starting row and column and the total columns of the users
' selection.
startRow = Selection.row
startColumn = Selection.Column
totalColumns = Selection.Columns.Count

'Loops through the selected range by column and row.
For c = startColumn To (startColumn + (totalColumns - 1))
For r = startRow To (startRow + (totalRows - 1))

'Shows the cell selections visually.
Cells(r, c).Select 'Debug

'Check to see if the cell has content and if it is numeric.
If Not IsEmpty(Cells(r, c).Value) And IsNumeric(Cells(r, c).Value) Then

'If the cell content is numeric, stores the content and then
' changes it to text in order to use string manipulation methods
' to check for and change the strikethrough the state of individual
' characters.
cellValue = Cells(r, c).Value
Cells(r, c).ClearContents
Cells(r, c).NumberFormat = "@"
Cells(r, c).Value = CStr(cellValue)

End If

'Checks if the cell contents are in Date format.
'Changed dates would be formatted as text.
If IsDate(Cells(r, c).Value) Then
'Dates can be represented in many different ways. If the date,
' could be confused as a number this conditional catches it based
' on the length of the string.
If (Len(Cells(r, c).Value) >= 8) Then

'If the cell format is strikethrough, changes the cell value to null.
If Cells(r, c).Font.Strikethrough Then

Cells(r, c).Value = Null

End If

End If

End If

'Now that numeric and date formats are taken care of, we are down to text.\
'This section loops through the cells text one character at a time and check
'if the text is formatted as strikethrough.
'If it is, it is delted, if not, it is passed over.
For i = Len(Range(Cells(r, c), Cells(r, c)).Text) To 1 Step -1

If Range(Cells(r, c), Cells(r, c)).Characters(i, 1).Font.Strikethrough Then

Range(Cells(r, c), Cells(r, c)).Characters(i, 1).Delete

End If

Next i

'Changes the cell format to Regular instead of Strikethrough so that
' the next person to type in the cell will get regular text.
With Range(Cells(r, c), Cells(r, c)).Font
.Strikethrough = False
End With

' If the cell is not empty ....
If Not IsEmpty(Cells(r, c).Value) Then

'Removes extra leading and trailing spaces.
cellValue2 = Trim(Cells(r, c).Value)
'If the cell is still not empty.
If Len(cellValue2) > 0 Then
'Changes the cell value to decimal.
'This will cause an error is the text doesn't
' look like a decimal number.
' In that case, the line gets skipped.
On Error Resume Next
Cells(r, c).Value = CDec(cellValue2)
End If
End If
Next r
Next c
End With
End With

End Sub