Finding duplicates highlight issue when using Excel 2010 Macros/VBA

[Lacey242]

I am trying to find and highlight duplicates when copied from one workbook into another. The macro seems to work except for the first duplicate. Example: Copied Invoice 3033 into new file, copied next line which was a duplicate of invoice 3033 nothing gets highlighted but then when I copied the same invoice in a third time it now shows both the 2nd and 3rd lines as highlighted. How can I make it highlight when the second line of data is the duplicate. Below is the macro with the duplicate area in Bold and further down is sample data.

Dim WB As Workbook
Dim strFile As String
strFile = Application.GetOpenFilename
Workbooks.Open strFile
ActiveSheet.Select
Sheets("Pull Invoice Data").Select
Range("A2:n2").Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Invoice Data").Select
lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & lMaxRows + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("N1").Select
With Selection
.FormatConditions.Delete
.FormatConditions.AddUniqueValues
.FormatConditions(1).DupeUnique = xlDuplicate
.FormatConditions(1).Interior.Color = RGB(255, 0, 0)
End With
Range("N1").Select
myTitle = "Duplicates"
myMsg = "Are there duplicates in file, If Yes macro will exit, if No macro will continue"
Responses = MsgBox(myMsg, vbExclamation + vbYesNo, myTitle)
Select Case Responses
Case Is = vbYes
Exit Sub
Case Is = vbNo
End Select
ActiveWindow.ActivateNext
Sheets("Pull Detail Data").Select
Range("A2", ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("$A$1:$q$30").AutoFilter Field:=1, Criteria1:="0"
Selection.Delete
Selection.AutoFilter
Range("A2", ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
ActiveWindow.ActivateNext
Sheets("Detail Data").Select
lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & lMaxRows + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ActivateNext
Dim FileName As Variant
Dim Filt As String, Title As String
Dim FilterIndex As Long, Response As Long
' Set to Specified Path\Folder
ChDir "C:\Documents and Settings\All Users\Desktop\"
' Set File Filter
Filt = "Excel Files (*.xlsm), *.xlsm"
' Set *.* to Default
FilterIndex = 5
' Set Dialogue Box Caption
Title = "Please select a different File"
' Get FileName
FileName = Application.GetSaveAsFilename(InitialFileName:=Range("A1"), FileFilter:=Filt, _
FilterIndex:=FilterIndex, Title:=Title)
' Exit if Dialogue box cancelled
If FileName = False Then
Response = MsgBox("No File was selected", vbOKOnly & vbCritical, "Selection Error")
Exit Sub
End If
' Display Full Path & File Name
Response = MsgBox("You selected " & FileName, vbInformation, "Proceed")
' Save & Close Workbook
With ActiveWorkbook
.SaveAs FileName
.Close
End With





End Sub

Entered	InvoiceNumber	Job Number	InvoiceDate	VendorID	Vendor Name	Amount	Validation
8/7/2013	3033	27111, 27112, 27113	8/5/2013	0000011111	ABC COMPANY	3207.25	303300000111113207.25
8/7/2013	3033	27111, 27112, 27113	8/5/2013	0000011111	ABC COMPANY	3207.25	303300000111113207.25
8/7/2013	3033	27111, 27112, 27113	8/5/2013	0000011111	ABC COMPANY	3207.25	303300000111113207.25

<COLGROUP><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 87pt; mso-width-source: userset; mso-width-alt: 4242" width=116><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 69pt; mso-width-source: userset; mso-width-alt: 3364" width=92><COL style="WIDTH: 94pt; mso-width-source: userset; mso-width-alt: 4571" width=125><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 99pt; mso-width-source: userset; mso-width-alt: 4827" width=132><TBODY>
</TBODY>

 

[sergioMabres]

Hi Lacey,
I am not 100% sure but I guess if column N contains the invoice number you need to change the code to

...
' Old code
Range("N1").Select
        With Selection
        .FormatConditions.Delete
        .FormatConditions.AddUniqueValues
        .FormatConditions(1).DupeUnique = xlDuplicate
        .FormatConditions(1).Interior.Color = RGB(255, 0, 0)
    End With
...
' change to new code
...
[B]Range("N1", Range("N1").End(xlDown)).Select[/B]
With Selection
.FormatConditions.Delete
.FormatConditions.AddUniqueValues
.FormatConditions(1).DupeUnique = xlDuplicate
.FormatConditions(1).Interior.Color = RGB(255, 0, 0)
End With
...

And see what happens
Cheers
Sergio

 

[Lacey242]

Thanks this works! Have a great day!

 

[sergioMabres]

glad to help