DELETE ROWS IN A COLUMN BASED ON MULTIPLE CRITERIA

[rhwebb]

Okay great gurus of VBA. I'm hoping for a solution to a problem I'm having with a spreadsheet. An example is provided. I need to delete rows in COLUMNS "D", "E" and "F". The criteria for keeping the row is if there is a date (identifier being "/" symbol). I have been able to do this successfully. The problem is that my header rows: the rows containing "> 30 days", ">60 days", "> 90 days" gets deleted as well. So my result is columns D, E, and F cells with dates remain. Top header rows remain. In this example: River City, Lakeside. But the second row of each header is deleted. The row number will be variable each day so I can't isolate row 17 (in this example) for protection. Even when I write code to the effect of <>"", (not equal blank) my headers are deleted. If you've encountered something similar and know the solution I'd definitely appreciate a lesson.

Thank you

 

[Trebor76]

Hi rhwebb,

Try this (initially on a copy of your data as the results cannot be undone if they're not as expected) which also uses the Student ID in Col. C as an initial check before checking that there's a date in columns D, E and F:

Option Explicit
Sub Macro1()

    Dim lngRow As Long, lngDelRowCount As Long
    Dim rngDelete As Range
    Dim wsSrc As Worksheet
    
    Application.ScreenUpdating = False
    
    Set wsSrc = ThisWorkbook.Sheets("Sheet1") 'Sheet name containing data to delete. Change to suit if necessary.
    
    With wsSrc
        For lngRow = 1 To .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            If Len(.Range("C" & lngRow)) > 0 And IsNumeric(.Range("C" & lngRow)) = True Then
                If IsDate(.Range("D" & lngRow)) = False And IsDate(.Range("E" & lngRow)) = False And IsDate(.Range("F" & lngRow)) = False Then
                    If rngDelete Is Nothing Then
                        Set rngDelete = .Cells(lngRow, "A")
                    Else
                        Set rngDelete = Union(rngDelete, Cells(lngRow, "A"))
                    End If
                End If
            End If
        Next lngRow
    End With
    
    'If the 'rngDelete' range has been set, then...
    If Not rngDelete Is Nothing Then
        '1. Count the number of rows to be deleted
        '2. Delete the relevant rows
        '3. Inform the user how many rows have been deleted
        lngDelRowCount = Application.WorksheetFunction.CountA(rngDelete)
        rngDelete.EntireRow.Delete
        MsgBox "There were " & lngDelRowCount & " rows that matched the desired criteria and have now been deleted.", vbInformation, "Delete Row Editor"
    'Else...
    Else
        '...inform the user that no rows were deleted as there was no matching criteria in the dataset.
        MsgBox "There were no rows deleted as none matched the required criteria.", vbExclamation, "Delete Row Editor"
    End If
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

 

[rhwebb]

While this did keep the header rows, it deleted all of the cells containing dates in the columns. So we're probably on the right track. I need to keep the headers and the cells with dates in the respective columns. So in the example provided, the only rows left were the blue header rows.

 

[Trebor76]

While this did keep the header rows, it deleted all of the cells containing dates in the columns. So we're probably on the right track. I need to keep the headers and the cells with dates in the respective columns. So in the example provided, the only rows left were the blue header rows.

That's odd as it worked for me

What format are the student ID's and dates in? Maybe they are text (strings) and not numbers and dates respectively.

Step through the code by pressing F8 from within the code and see what each line is doing.

 

[rhwebb]

That's odd as it worked for me

What format are the student ID's and dates in? Maybe they are text (strings) and not numbers and dates respectively.

Step through the code by pressing F8 from within the code and see what each line is doing.

Okay I will give that a go. Let you know as soon as I can run the code again.

 

[rhwebb]

OK. the header and dates are in a general format. Cycled through the MACRO and it runs through the script for each row. But again, it's looking for dates where as I have dates in text format. Realistically, I have figured out a way to delete unwanted dates but I need to keep the headers. I can't just identify a row because the location is variable.

 

[Trebor76]

Try this slight modification of my original macro:

Option Explicit
Sub Macro1()

    Dim lngRow As Long, lngDelRowCount As Long
    Dim rngDelete As Range
    Dim wsSrc As Worksheet
    
    Application.ScreenUpdating = False
    
    Set wsSrc = ThisWorkbook.Sheets("Sheet1") 'Sheet name containing data to delete. Change to suit if necessary.
    
    With wsSrc
        For lngRow = 1 To .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            'If the entry in Col. C of 'lngRow' is 6 characters long (assumes all Student ID's are 6 characters long), then...
            If Len(.Range("C" & lngRow)) = 6 Then
                '...if the entry is numeric (assumes all Student ID's are numeric), then...
                If IsNumeric(.Range("C" & lngRow)) = True Then
                    '...if there are no entries across columns D to F (inclusive) then...
                    If Evaluate("COUNTBLANK('" & wsSrc.Name & "'!D" & lngRow & ":F" & lngRow & ")") = 3 Then
                        '...add the row to the 'rngDelete' variable
                        If rngDelete Is Nothing Then
                            Set rngDelete = .Rows(lngRow)
                        Else
                            Set rngDelete = Union(rngDelete, .Rows(lngRow))
                        End If
                    End If
                End If
            End If
        Next lngRow
    End With
    
    'If the 'rngDelete' range has been set, then...
    If Not rngDelete Is Nothing Then
        '1. Count the number of rows to be deleted
        '2. Delete the relevant rows
        '3. Inform the user how many rows have been deleted
        lngDelRowCount = Application.WorksheetFunction.CountA(rngDelete)
        rngDelete.EntireRow.Delete
        MsgBox "There were " & lngDelRowCount & " rows that matched the desired criteria and have now been deleted.", vbInformation, "Delete Row Editor"
    'Else...
    Else
        '...inform the user that no rows were deleted as there was no matching criteria in the dataset.
        MsgBox "There were no rows deleted as none matched the required criteria.", vbExclamation, "Delete Row Editor"
    End If
    
    Application.ScreenUpdating = True

End Sub

I've added comments to illustrate how a row is selected to be added to the 'rngDelete' variable for it then to be subsequently deleted. If this still doesn't work (it does for me) you'll have to post the actual workbook (devoid of all sensitive information) for us to provide an answer.

Regards,

Robert

 

[rhwebb]

It works on my sample. I'll have to pull it into my original document to see if it will work there as well. Thank you for your help to this point.

 

[rhwebb]

Try this slight modification of my original macro:

Option Explicit
Sub Macro1()

    Dim lngRow As Long, lngDelRowCount As Long
    Dim rngDelete As Range
    Dim wsSrc As Worksheet
   
    Application.ScreenUpdating = False
   
    Set wsSrc = ThisWorkbook.Sheets("Sheet1") 'Sheet name containing data to delete. Change to suit if necessary.
   
    With wsSrc
        For lngRow = 1 To .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            'If the entry in Col. C of 'lngRow' is 6 characters long (assumes all Student ID's are 6 characters long), then...
            If Len(.Range("C" & lngRow)) = 6 Then
                '...if the entry is numeric (assumes all Student ID's are numeric), then...
                If IsNumeric(.Range("C" & lngRow)) = True Then
                    '...if there are no entries across columns D to F (inclusive) then...
                    If Evaluate("COUNTBLANK('" & wsSrc.Name & "'!D" & lngRow & ":F" & lngRow & ")") = 3 Then
                        '...add the row to the 'rngDelete' variable
                        If rngDelete Is Nothing Then
                            Set rngDelete = .Rows(lngRow)
                        Else
                            Set rngDelete = Union(rngDelete, .Rows(lngRow))
                        End If
                    End If
                End If
            End If
        Next lngRow
    End With
   
    'If the 'rngDelete' range has been set, then...
    If Not rngDelete Is Nothing Then
        '1. Count the number of rows to be deleted
        '2. Delete the relevant rows
        '3. Inform the user how many rows have been deleted
        lngDelRowCount = Application.WorksheetFunction.CountA(rngDelete)
        rngDelete.EntireRow.Delete
        MsgBox "There were " & lngDelRowCount & " rows that matched the desired criteria and have now been deleted.", vbInformation, "Delete Row Editor"
    'Else...
    Else
        '...inform the user that no rows were deleted as there was no matching criteria in the dataset.
        MsgBox "There were no rows deleted as none matched the required criteria.", vbExclamation, "Delete Row Editor"
    End If
   
    Application.ScreenUpdating = True

End Sub

I've added comments to illustrate how a row is selected to be added to the 'rngDelete' variable for it then to be subsequently deleted. If this still doesn't work (it does for me) you'll have to post the actual workbook (devoid of all sensitive information) for us to provide an answer.

Regards,

Robert

yes! Was able to get this to work with a little modification of my original sheet. Thank you for the help.

 

[Trebor76]

yes! Was able to get this to work with a little modification of my original sheet. Thank you for the help.

Thanks for the letting us know and you're welcome