Interesting Macro

[yupyaknow]

I have 1000's of rows of data. I need three actions to run based on data in two columns (out of about 8 columns).

-Find all groups of duplicates in column A
-With in each group of duplicates determine if value in column B is >= 20140501
-If true, then delete entire group of rows (including first row) and shift up

In essence I'm trying to get rid of not only duplicates but the whole group of rows that share the same value in Column A, IF a row in that group has a Column B value of '20140501' or greater.

What do ya think?

 

[JLGWhiz]

This assumes you have sorted on column A to group all duplicates.

Make a copy of your file to test this on.

Sub delStuff()
Dim sh As Worksheet, lr As Long
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
    For i = lr To 2 Step -1
        If sh.Cells(i, 1) = sh.Cells(i - 1, 1) Then
            cnt = cnt + 1
        Else
            If Application.CountIf(sh.Cells(i, 2).Resize(cnt + 1, 1), ">=20140501") > 0 Then
                sh.Cells(i, 1).Resize(cnt + 1, 1).EntireRow.Delete
            End If
        cnt = 0
        End If
    Next
End Sub

 

[yupyaknow]

Thanks,
I'm not getting it to work. Here's what I'm using...I've changed the name and added a msgbox to the end. I think it might have to do with the way I am referring to the sheet. I've troublshot it quite a bit. Still can't get it to work. Your help is most appreciated by the way. This is an interesting challenge.

Sub delStuff3()
Dim sh As Worksheet, lr As Long
Set sh = Sheet1    'Edit Sheet Name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
    For i = lr To 2 Step -1
        If sh.Cells(i, 1) = sh.Cells(i - 1, 1) Then
            cnt = cnt + 1
        Else
            If Application.CountIf(sh.Cells(i, 2).Resize(cnt + 1, 1), ">=20140501") > 0 Then
                sh.Cells(i, 1).Resize(cnt + 1, 1).EntireRow.Delete
            End If
        cnt = 0
        End If
    Next
    MsgBox "Completed"
End Sub

This assumes you have sorted on column A to group all duplicates.

Make a copy of your file to test this on.

Sub delStuff()
Dim sh As Worksheet, lr As Long
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
    For i = lr To 2 Step -1
        If sh.Cells(i, 1) = sh.Cells(i - 1, 1) Then
            cnt = cnt + 1
        Else
            If Application.CountIf(sh.Cells(i, 2).Resize(cnt + 1, 1), ">=20140501") > 0 Then
                sh.Cells(i, 1).Resize(cnt + 1, 1).EntireRow.Delete
            End If
        cnt = 0
        End If
    Next
End Sub

 

[JLGWhiz]

Your code is working for me based on the criteria established in the OP, i.e. column B has a value >=20140501. Do you have the code installed in Module 1 or any nujmbered code module. It might not work too well from a sheet code module.

 

[yupyaknow]

I have it installed in Module 1, Here's my setup. Maybe you can see something wrong.
I've tried running it from within excel and by simply hitting run in the VB Editor toolbar. What do you see?

 

[JLGWhiz]

The problem appears to be that you are using row 1 with the same value as row 2. The code assumes row 1 as a header row, normally a different value in A1 than in A2. I could modify the code, or you could just inser a blank row for row 1 and fix the problem.

 

[yupyaknow]

lol! Awesome!!! you sir, rock!

 

[JLGWhiz]

Here is the modified code to make the other configuration work.

Sub delStuff4()
Dim sh As Worksheet, lr As Long
Set sh = Sheet1    'Edit Sheet Name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
    For i = lr To 2 Step -1
        
        If sh.Cells(i, 1) = sh.Cells(i - 1, 1) Then
            cnt = cnt + 1
            If i = 2 And sh.Cells(i, 1).Value = sh.Cells(i - 1, 1).Value Then
                sh.Cells(i - 1, 1).Resize(cnt + 1, 1).EntireRow.Delete
                GoTo SKIP:
            End If
        Else
            If Application.CountIf(sh.Cells(i, 2).Resize(cnt + 1, 1), ">=20140501") > 0 Then
                sh.Cells(i, 1).Resize(cnt + 1, 1).EntireRow.Delete
            End If
        cnt = 0
        End If
    Next
SKIP:
    MsgBox "Completed"
End Sub

Regards, JLG