Removing the Strikethrough data

[shruthidwh]

HI ,

I am using the below code for removing the strike through data from column E, but I have to remove strike through from all the xls files in a particular folder (C:\Data),most of the times these xls files will have two worksheets or one worksheets the macro has to delete the strikethrough data. Please provide me guidance for writing the macro.

Sub ClearNEWStrikethrough()
Dim lastrow As Long
Dim icell As Long

lastrow = Range("E" & Rows.Count).End(xlUp).Row

For icell = 1 To lastrow
    With Range("E" & icell)
        If .Font.Strikethrough = True Then
            .ClearContents
        End If
        End With
Next icell
        
End Sub

Thx,
shruthi

[mojo249]

Try the code below.

Make sure you set a reference to Microsoft Scripting Runtime and you specify the folder you want to search on the line which starts Set FSfolder = .

The code loops through all Excel workbooks in the specified folder and then loops through all sheets in each workbook that it finds.

Sub LoopXLS()

'Requires reference to Microsoft Scripting Runtime
        
Dim FS As New FileSystemObject
Dim FSfolder As Folder
Dim varFile As File
Dim wb As Object
Dim ws As Worksheet
Dim lastrow As Long
Dim icell As Long

       Set FSfolder = FS.GetFolder("C:\Users\Temp\Main Folder") 'ENTER YOUR START FOLDER HERE
        
       For Each varFile In FSfolder.Files
            If varFile.Name Like "*.xls*" Then
                Workbooks.Open varFile.Path
                
                Set wb = ActiveWorkbook
                
                For Each ws In wb.Worksheets
                    ws.Select

                    lastrow = Range("E" & Rows.Count).End(xlUp).Row
                    
                    For icell = 1 To lastrow
                        With Range("E" & icell)
                            If .Font.Strikethrough = True Then
                                .ClearContents
                            End If
                            End With
                    Next icell
                Next ws
                
                wb.Close True
                
            End If
       Next varFile
        
       Set FSfolder = Nothing
       Set wb = Nothing
End Sub