Name Range, Variable # of Rows, Compare data, then Keep or delete

[BEEJAY]

Greetings:
I hope someone has the patience to help work the following thru with me.
(assuming my descriptions make sense)

I'm looking to do something like the following:
Check Cell A2; Determine how many rows down are exactly same as A1;
Select A2 down to last equal cell and across all columns; Name Range
Within Range: check Column "AZ";
Employee number to be identical in each cell of column AZ, within that range.

If NOT, delete complete range. Process same procedure on next Range.
If YES, then leave complete range alone, and continue to next Range and
repeat process.
SAMPLE
A AZ
1 Job # Employ #
2 2489 113
3 2489 113
4 2489 228
5 2489 113
6 2650 220
7 2650 295
8 2650 331
9 2722 222
10 2722 222

1st range would be A2 / AZ5: (all the same Job Number)
The range would be deleted, since there is more than one employee identified
on that job
2nd range: A6 / AZ8: All Same Job Numbers, but, again more than one employee.
Delete that range, as well
3rd Range: A9 / AZ10: Same job number - Only ONE employee listed on that
job.
Keep the range intact, and move onto next range (which would be A11 / AZ ???

Etc.,........., until there are no more rows to process.

Any help would be greatly appreciated.

 

[Dave Peterson]

If you don't have headers in row 1, add them before you run this code. And make
sure the values in the headers in row 1 are not the same as the data in row 2.

(And if your data isn't sorted by column A, do that first--or each group will be
treated separately.)

Test this against a copy of your worksheet--just in case.

And I used .select to show you the range that should be deleted. You can change
this line:
DelRng.EntireRow.Select
to
DelRng.EntireRow.Delete
When you've done a few tests and are happy with it.

Anyway....

Option Explicit
Sub testme()

Dim wks As Worksheet
Dim iRow As Long
Dim LastRow As Long
Dim FirstRow As Long
Dim BotRow As Long
Dim TopRow As Long
Dim FoundADifference As Boolean
Dim HowManyCellsInGroup As Long
Dim HowManyTheSame As Long
Dim DelRng As Range

Set wks = ActiveSheet

With wks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

BotRow = LastRow
TopRow = LastRow
FoundADifference = False
For iRow = LastRow To FirstRow Step -1
If .Cells(iRow, "A").Value = .Cells(iRow - 1, "A").Value Then
'same keep looking
Else
TopRow = iRow
FoundADifference = True
End If

If FoundADifference Then
HowManyCellsInGroup = BotRow - TopRow + 1
HowManyTheSame = Application.CountIf(.Cells(TopRow, "AZ") _
.Resize(HowManyCellsInGroup), _
.Cells(TopRow, "AZ").Value)
If HowManyTheSame = HowManyCellsInGroup Then
'hey, they match! Let's keep them!
Else
If DelRng Is Nothing Then
Set DelRng = .Cells(TopRow, "A") _
.Resize(HowManyCellsInGroup)
Else
Set DelRng = Union(DelRng, .Cells(TopRow, "A") _
.Resize(HowManyCellsInGroup))
End If
End If
'get ready for the next possible group
TopRow = iRow - 1
BotRow = iRow - 1
FoundADifference = False
End If
Next iRow

If DelRng Is Nothing Then
MsgBox "Nothing to delete!"
Else
DelRng.EntireRow.Select '.delete when you're done testing!
End If
End With

End Sub