How to delete the rows with strikethrough on column A among multiple sheets

[homing]

Hello,

I have a workbook with multiple sheets. I want to use VBA macro to delete the row where the first column is strikethrough. I try to the follow VBA code but it doesn't work. Could someone help me to solve this issue? Thanks in advance!

Sub Macro1()
Dim cell As Range
Dim delRange As Range

'Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False

Workbooks.Open Filename:="D:\reaserch\DeleteStrikeThroughs.xlsx"
For Each WS In ActiveWorkbook.Worksheets

For Each cell In Range("A1:A" & _
Range("A" & Rows.Count).End(xlUp).Row)
If cell.Font.Strikethrough Then
If delRange Is Nothing Then
Set delRange = cell
Else
Set delRange = Union(delRange, cell)
End If
End If
Next cell
If Not delRange Is Nothing Then delRange.EntireRow.Delete
Next WS
ActiveWorkbook.Save
ActiveWorkbook.Close

End Sub

 

[hiker95]

homing,

Welcome to the MrExcel forum.

What version of Excel and Windows are you using?


The Font.Strikethrough's are not displaying correctly - now displayed with Font.Strikethrough's in bold font.

Sample raw data in two worksheets:

Excel 2007
	A
1	one
2	two
3	three
4	four
5	five
6	six
7	seven
8	eight
9	nine
10	ten
11
Sheet1

Excel 2007
	A
1	one
2	two
3	three
4	four
5	five
6	six
7	seven
8	eight
9	nine
10	ten
11
Sheet2

After the macro:

Excel 2007
	A
1	one
2	three
3	five
4	six
5	seven
6	ten
7
8
9
10
11
Sheet1

Excel 2007
	A
1	two
2	four
3	five
4	seven
5	eight
6	nine
7
8
9
10
11
Sheet2

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub Macro1_V2()
' hiker95, 11/24/2013
' http://www.mrexcel.com/forum/excel-questions/741348-how-delete-rows-strikethrough-column-among-multiple-sheets.html
Dim r As Long, lr As Long
Dim WS As Worksheet
Application.EnableEvents = False
Application.ScreenUpdating = False
Workbooks.Open Filename:="D:\reaserch\DeleteStrikeThroughs.xlsx"
For Each WS In ActiveWorkbook.Worksheets
  With WS
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    For r = lr To 1 Step -1
      If .Cells(r, 1).Font.Strikethrough = True Then .Rows(r).Delete
    Next r
  End With
Next WS
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the Macro1_V2 macro.

 

[homing]

Hello Hiker95,

I use win xp and office 2007. The code you provided works! Thanks a lot for your kindly help!

 

[hiker95]

homing,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.