VBA to Loop through Excel list and Delete rows based on Criteria

Simon2001

New Member
Joined
Jun 28, 2019
Messages
5
Hi

I've got a spreadsheet, close to 50,000 rows, for which I have a VBA macro to autofilter on a certain criteria to reduce the number of rows (by deleting) to only have the ones I want left.

I now want to have the macro loop through the list to delete rows based on criteria in three colkumns, IF the same criteria appears in later rows further down the sheet. Hope this makes sense.

ABC
1Employee 1Course 1Completed
2Employee 1Course 2Not Completed
3Employee 1Course 3Completed
4Employee 1Course 4Completed
5Employee 2Course 1Completed
6Employee 3Course 1Completed
7Employee 1Course 2Completed
8Employee 2Course 2Completed
9Employee 2Course 3Completed
10Employee 1Course 5Completed

<tbody>
</tbody>

In this case, Employee 1 did not complete a training course (row 2) but did complete it later (Row 7).

I want the macro to loop down row by row to see if it can find all cases when an employee did not complete a course but did later on. I want it then to delete the first incomplete row (but only if it recurs later as completed). So in this case delete row 2 only for that employee. Then continue through the rest of the sheet.

Im fairly ok with the looping code, etc but not sure on what I need to do do to get it to scan down for the criteria.

Any ideas?

Thanks
 

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,626
Office Version
  1. 365
Platform
  1. Windows
How about
Code:
Sub Simon2001()
    Dim Cl As Range, Rng As Range
    
    With CreateObject("scripting.dictionary")
        .CompareMode = 1
        For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
            If LCase(Cl.Offset(, 2).Value) = "not completed" Then
                Set .Item(Cl.Value & "|" & Cl.Offset(, 1).Value) = Cl
            ElseIf .exists(Cl.Value & "|" & Cl.Offset(, 1).Value) Then
                If Rng Is Nothing Then Set Rng = .Item(Cl.Value & "|" & Cl.Offset(, 1).Value) Else Set Rng = Union(Rng, .Item(Cl.Value & "|" & Cl.Offset(, 1).Value))
            End If
        Next Cl
    End With
    If Not Rng Is Nothing Then Rng.EntireRow.Delete
End Sub
 

Simon2001

New Member
Joined
Jun 28, 2019
Messages
5
Hi, thanks for the quick reply, let me see if I can integrate and get it to work. Will get back to you in the morning.

Thanks
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,626
Office Version
  1. 365
Platform
  1. Windows
Ok, look forward to hearing back.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,765
Messages
5,626,742
Members
416,201
Latest member
brianhf

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top