Hi-lite duplicate rows. 2

[ColdDay]

I am wanting to hi-lite all rows that are duplicates based on the Number, Job and Date. In the following, rows 4,5 and 6 are dupes based on their same values. Rows 7 and 8 are dupes based on their same values. Same for 9 & 10, plus 13 & 14. Problem is that rows 7 & 8 are not being hi-lited when I run the code below. The others are. I have tested different values and have the same problem. When rows with the same values are hi-lited, then the rows immediately following (i.e. 7 & 8) are not hi-lited, even though they should be.
[pre]
Row Number Job Hours Units Date
2 1000 2 1 9 1/1/2014
3 1000 3 1 9 1/1/2014
4 1000 1 1 9 1/1/2014
5 1000 1 1 9 1/1/2014
6 1000 1 1 9 1/1/2014
7 1001 2 1 9 1/4/2014
8 1001 2 1 9 1/4/2014
9 1002 3 1 9 1/2/2014
10 1002 3 1 9 1/2/2014
11 1003 4 1 9 1/1/2014
12 1003 5 1 9 1/1/2014
13 1004 5 1 9 1/2/2014
14 1004 5 1 9 1/2/2014
15 1004 6 1 9 1/2/2014
[/pre]

Here is the code I am using. I have found a number of duplicates code, but I picked this one b/c it was the easiest for me to understand and follow. I think the problem is in the .Offset(1,0) line in the loop right before Else. If there is a better way to do this, I'm open to it as well. I'm looking at thousands of records that need to be checked.

Sub FindDups()
Application.ScreenUpdating = False
   ' NOTE: make sure that the column is sorted before running this macro
   'Find color pallete at: [URL unfurl="true"]http://www.excel-pratique.com/en/vba/colors.php[/URL]
Dim FirstItem As String 'Number
Dim SecondItem As String 'Number
Dim ThirdItem As String 'Job
Dim FourthItem As String 'Job
Dim FifthItem As String 'Date
Dim SixthItem As String 'Date

'need sort code here. sort by Number, Job and date.
 'clear out any existing cell color
   Rows.Interior.ColorIndex = xlColorIndexNone

Range("A1").Select

With Selection
   FirstItem = ActiveCell.Value              'col A 'Number
   SecondItem = ActiveCell.Offset(1, 0).Value  'col A. row below FirstItem
   
   ThirdItem = ActiveCell.Offset(0, 1).Value 'col B. Job. same row as FirstItem
   FourthItem = ActiveCell.Offset(1, 1).Value 'col B and row below FirstItem
   
   FifthItem = ActiveCell.Offset(0, 4).Value 'col E Date
   SixthItem = ActiveCell.Offset(1, 4).Value 'col E Date

'after hi-lighting matching rows (can be more than 2 rows), skips the next row unless it is a match to the _
    previous row. But if the next two rows after the last matching row are a match _
    they are not hi-lighted b/c the first one is skipped.
'
   Do While ActiveCell <> ""
      If FirstItem = SecondItem And ThirdItem = FourthItem And FifthItem = SixthItem Then
        ActiveCell.Offset(0, 0).EntireRow.Interior.ColorIndex = 27 'colors cell in col A yellow
        SecondItem = ActiveCell.Offset(1, 0).Value
        ThirdItem = ActiveCell.Offset(0, 1).Value
        FourthItem = ActiveCell.Offset(1, 1).Value
        FifthItem = ActiveCell.Offset(0, 4).Value
        SixthItem = ActiveCell.Offset(1, 4).Value
        'if rem the following offset, gets caught in loop
        ActiveCell.Offset(1, 0).Select
      Else
        ActiveCell.Offset(1, 0).Select
        FirstItem = ActiveCell.Value
        SecondItem = ActiveCell.Offset(1, 0).Value
        ThirdItem = ActiveCell.Offset(0, 1).Value 'col B. same row as FirstItem
        FourthItem = ActiveCell.Offset(1, 1).Value 'col B. same row as SecondItem
        FifthItem = ActiveCell.Offset(0, 4).Value
        SixthItem = ActiveCell.Offset(1, 4).Value
      End If
   Loop
End With
Range("A1").Select
Application.ScreenUpdating = True
End Sub

I also looked at the following. I used G as a helper column and combined the data in cols A, B & E with =A&B&E. It only places "Duplicate" in the rows of following dupes, not the first row that is also a dupe. Plus, I want the rows hi-lited.

=IF(ISNA(VLOOKUP(G2,$G3:$G$20000,1,0)),"","Duplicate")

Thanks for the help.

 

[PHV]

A simplified version of your code that should work:

Sub FindDups()
Application.ScreenUpdating = False
' NOTE: make sure that the column is sorted before running this macro
'Find color pallete at: [URL unfurl="true"]http://www.excel-pratique.com/en/vba/colors.php[/URL]
Dim FirstItem As String    'Number
Dim SecondItem As String    'Number
Dim ThirdItem As String    'Job
Dim FourthItem As String    'Job
Dim FifthItem As String    'Date
Dim SixthItem As String    'Date

'need sort code here. sort by Number, Job and date.
'clear out any existing cell color
Rows.Interior.ColorIndex = xlColorIndexNone

Range("A2").Select

FirstItem = ActiveCell.Value              'col A 'Number
SecondItem = ActiveCell.Offset(1, 0).Value  'col A. row below FirstItem

ThirdItem = ActiveCell.Offset(0, 1).Value    'col B. Job. same row as FirstItem
FourthItem = ActiveCell.Offset(1, 1).Value    'col B and row below FirstItem

FifthItem = ActiveCell.Offset(0, 4).Value    'col E Date
SixthItem = ActiveCell.Offset(1, 4).Value    'col E Date

'after hi-lighting matching rows (can be more than 2 rows), skips the next row unless it is a match to the _
 previous row. But if the next two rows after the last matching row are a match _
 they are not hi-lighted b/c the first one is skipped.
'
Do While ActiveCell <> ""
    ActiveCell.Offset(1, 0).Select
    If FirstItem = SecondItem And ThirdItem = FourthItem And FifthItem = SixthItem Then
        ActiveCell.Offset(-1, 0).EntireRow.Interior.ColorIndex = 27
        ActiveCell.Offset(0, 0).EntireRow.Interior.ColorIndex = 27
    End If
    FirstItem = ActiveCell.Value
    SecondItem = ActiveCell.Offset(1, 0).Value
    ThirdItem = ActiveCell.Offset(0, 1).Value    'col B. same row as FirstItem
    FourthItem = ActiveCell.Offset(1, 1).Value    'col B. same row as SecondItem
    FifthItem = ActiveCell.Offset(0, 4).Value
    SixthItem = ActiveCell.Offset(1, 4).Value
Loop
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Andrzejek]

...or try something simple like this:

Dim intNo As Integer
Dim intjob As Integer
Dim strDate As String
Dim i As Integer

i = 2
Do While Range("A" & i).Value <> ""
    If Range("A" & i).Value = intNo And _
        Range("B" & i).Value = intjob And _
        Range("E" & i).Value = strDate Then
    
        Range("A" & i - 1 & ":E" & i).Interior.Color = 65535
    End If

    intNo = Range("A" & i).Value
    intjob = Range("B" & i).Value
    strDate = Range("E" & i).Value

    i = i + 1
Loop

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[ColdDay]

I've gotta give both of you a star. Wow.

My super saw what I was doing and gave me a new project. Finding duplicates in our patient accounting records. I have to modify the code a bit, but it should work. If I have any issues I'll be back.

Thanks for the help!

Bill

 

[Andrzejek]

So I see this little exercise ‘back-fired’ at you and now you have to do it :-(

BTW – do you have your ‘patient accounting records’ in Excel? Wouldn’t it better to have it in some kind of data base?


Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[ColdDay]

Andy,

Sorry for the delay in answering your Q. The patient records are in 2 systems (I don't know why) and the super is wanting to see what is in one and not the other. She exported from both and now wants to compare. I'm not involved in the patient records part, I'm just trying to make her life (and in turn my own) a bit easier. Thanks.

Bill