Deleting all rows that meet a certain condition, for multiple files

[longtalker]

Hi everyone

I have a bunch of spreadsheets in a folder, and all of them need to have the following operation done upon them: whenever a cell in the C column is smaller than -1000 or greater than 1000, then the whole row that contains that cell gets deleted.

Any macro that could do this for all files (and subsequently save&close them)? Also, if it's not too complicated, is there a way for the macro to create a log file with all the rows that were deleted for each file?

Anticipated thanks!
(sorry for cross posting this question on another forum as well, I just need to find a solution to this quite soon)

 

[texasalynn]

please put in the post to the cross post so that we don't waste time if someone else has already answered.

 

[longtalker]

Sorry, here they are:
http://www.excelforum.com/excel-gen...condition-for-multiple-files.html#post2498955

http://answers.microsoft.com/en-us/...-325a-e011-8dfc-68b599b31bf5?tm=1301423440420

 

[John_w]

Try this, but test it on a copy of your folder. The workbook containing this code becomes the log file and should be saved in a separate folder.

You haven't said which sheet(s) in the workbooks should be checked, e.g. one or all. The code checks the first sheet in each workbook but can be easily changed to check all sheets.

Public Sub Loop_All_Workbooks_in_Folder()

    Dim folder As String
    Dim filename As String
    Dim logRange As Range
    
    Set logRange = Sheets("Sheet1").Range("A1")     'SHEET AND STARTING CELL IN THIS WORKBOOK IN WHICH THE DELETED ROWS WILL BE LOGGED
    
    folder = "C:\Temp\Excel\"               'FOLDER CONTAINING WORKBOOKS TO BE CHECKED
    
    filename = Dir(folder & "*.xls")
    Do While filename <> vbNullString
        Workbooks.Open folder & filename
        Delete_Rows_in_Workbook logRange
        ActiveWorkbook.Close savechanges:=True
        filename = Dir
    Loop

End Sub


Private Sub Delete_Rows_in_Workbook(logRange As Range)

    Dim lastRow As Long, row As Long
    
    'Look at 1st sheet in workbook
    
    With ActiveWorkbook.Sheets(1)
        lastRow = .Cells(.Rows.Count, "C").End(xlUp).row        
        row = 1
        While row < lastRow
            If .Cells(row, "C").Value < -1000 Or .Cells(row, "C").Value > 1000 Then
                .Cells(row, "C").EntireRow.Copy logRange
                Set logRange = logRange.Offset(1, 0)
                .Cells(row, "C").EntireRow.Delete
            Else
                row = row + 1
            End If
        Wend
    End With
    
End Sub

As a courtesy to the members of the other forums, please post a link to this thread in your other threads.

 

[longtalker]

Thank you very much indeed John! I posted a linked to this thread in the other threads.