Excel VBA to delete rows from workbooks from specific data set

[Chase_Luke]

My goal is to delete rows from multiple different workbooks by using a specific set of data as the criteria.

My data set for the deletion criteria is just over 18K rows (A2:A18052), containing both letters and numbers. Something like this:

ContractNumber

123123123

123ABC123ABC

345345345

So I want any rows with these contract numbers deleted from all workbooks in my file path. Contract Number in external workbooks is in column "C".

Here is what I have so far:

Sub DeleteArray()
   
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim MyArray As Variant
    Dim currentFile, currentSheet, lastRow, baseDirectory As String
    
    With ActiveSheet
        MyArray = Range("A2:A18052").Value
    End With

    baseDirectory = "[folder path for external workbooks]"
    currentFile = Dir(baseDirectory)
    While (currentFile <> "")
        Workbooks.Open baseDirectory + currentFile
        For Each currentSheet In Workbooks(currentFile).Worksheets
        lastRow = currentSheet.Cells(currentSheet.Rows.Count, "C").End(xlUp).Row
        For j = 1 To lastRow
            If InStr(1, LCase(CStr(currentSheet.Cells(j, "C").Value)), MyArray) > 0 Then
                currentSheet.Cells(j, 1).EntireRow.Delete
                j = j - 1
                lastRow = lastRow - 1
                Exit For
            End If
            Next
        Next
        Workbooks(currentFile).Save
        Workbooks(currentFile).Close
        currentFile = Dir
    Wend

End Sub

I have an issue with the InStr function line -

            If InStr(1, LCase(CStr(currentSheet.Cells(j, "C").Value)), MyArray) > 0 Then
I basically used this to look up the deletion criteria, but is there a different function I can use? Or can I set it up differently to get it to recognize my array?

 

[John_w]

You can't use a whole array with InStr. You need another loop which applies each array element to InStr. Also, when deleting rows it's generally better to start at the bottom, so that you don't have to update loop variables when a row is deleted. With these changes your For j = ... Next loop becomes:

            For j = lastRow To 1 Step -1
                Dim i As Long
                For i = 1 To UBound(MyArray)
                    If InStr(1, LCase(CStr(currentSheet.Cells(j, "C").Value)), MyArray(i, 1)) > 0 Then
                        currentSheet.Cells(j, 1).EntireRow.Delete
                        Exit For
                    End If
                Next
            Next

Note that you could avoid the inner loop above and call InStr just once by creating a string of all the deletion criteria and swapping the InStr string arguments.

Also, do you really mean to use LCase? With that, 123ABC123ABC in the workbooks doesn't match 123ABC123ABC in MyArray.

 

[Chase_Luke]

Ahh...I had LCase in there when I was playing with using names as the deletion criteria instead of the Contract Number. It is not needed now. I removed LCase and used your changes and it works now. Many, many thanks!

 

[John_w]

Note that you could avoid the inner loop above and call InStr just once by creating a string of all the deletion criteria and swapping the InStr string arguments.

Here's the macro with my idea:

Public Sub Find_Criteria_Delete_Rows()
   
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim MyArray As Variant
    Dim currentFile As String, currentSheet As Worksheet, lastRow As Long, baseDirectory As String
    Dim j As Long
    Dim deletionList As String
    
    With ActiveSheet
        MyArray = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).Value
    End With
    
    deletionList = "|"
    For j = 1 To UBound(MyArray)
        deletionList = deletionList & MyArray(j, 1) & "|"
    Next
    
    baseDirectory = "C:\Folder\Path\"   'CHANGE AS NEEDED
    currentFile = Dir(baseDirectory)
    While currentFile <> vbNullString
        Set wb = Workbooks.Open(baseDirectory & currentFile)
        For Each currentSheet In wb.Worksheets
            lastRow = currentSheet.Cells(currentSheet.Rows.Count, "C").End(xlUp).Row
            For j = lastRow To 1 Step -1
                If InStr(1, deletionList, "|" & currentSheet.Cells(j, "C").Value & "|", vbTextCompare) > 0 Then
                    currentSheet.Cells(j, 1).EntireRow.Delete
                End If
            Next
        Next
        wb.Close SaveChanges:=True
        currentFile = Dir
    Wend

End Sub

That should be much faster because it doesn't loop through the 18K criteria rows for each row in the opened workbooks. The InStr uses vbTextCompare so is case-insensitive.

 

[Chase_Luke]

I was finally able to test this - runs much faster! Thank you!