Conditional Format Duplicates in Excel from Access

Using Microsoft Access/VBA, I'm copying a recordset from an Access query into an Excel spreadsheet. I'd like to use conditional formatting on column N to check for duplicates and highlight the cells in red.

I'm having a hard time finding a solution for this. Any help is greatly appreciated!

Function CDataAudit
Dim Rst As DAO.Recordset, i As Long
Dim ExlApp As Object, ExlBook As Object, ExlSheet As Object
On Error GoTo Function_Error

Dim strTemp As String: strTemp ='location of template
Dim strXLS As String: strXLS='location of output

Set ExlApp = CreateObject("Excel.Application")
Set ExlBook = ExlApp.Workbooks.Open(strTemp)
Set Rst = CurrentDb.OpenRecordset("qselDataAudit")

If Not Rst.EOF Then
    Rst.MoveLast
    i = Rst.RecordCount
End If

Rst.MoveFirst

With ExlBook
    .ActiveSheet.Range("A2").CopyFromRecordset Rst
    .Worksheets(1).Range("H2:H" & i).NumberFormat = "$#,##0.00"
    .Worksheets(1).Range("J2:J" & i).NumberFormat = "$#,##0.00"
    .Worksheets(1).Range("L2:L" & i).NumberFormat = "$#,##0.00"
End With

With ExlApp
    .ActiveWorkbook.SaveAs (strXLS)
End With

Function_Exit:
    If Not Rst Is Nothing Then
        Rst.Close
        Set Rst = Nothing
    End If
    If Not ExlSheet Is Nothing Then
        Set ExlSheet = Nothing
    End If
    If Not ExlBook Is Nothing Then
        Set ExlBook = Nothing
    End If
    If Not ExlApp Is Nothing Then
        ExlApp.Quit
        Set ExlApp = Nothing
    End If
        Exit Function
Function_Error:
    MsgBox Error$
    Resume Function_Exit
End Function

Open in new window

You can use the following code to do what you are looking for..

Function CDataAudit()
    Dim Rst As DAO.Recordset, i As Long
    Dim ExlApp As Object, ExlBook As Object, ExlSheet As Object
    On Error GoTo Function_Error

    Dim strTemp As String: strTemp =    'location of template
    Dim strXLS As String: strXLS=    'location of output

    Set ExlApp = CreateObject("Excel.Application")
    Set ExlBook = ExlApp.Workbooks.Open(strTemp)
    Set Rst = CurrentDb.OpenRecordset("qselDataAudit")

    If Not Rst.EOF Then
        Rst.MoveLast
        i = Rst.RecordCount
    End If

    Rst.MoveFirst

    With ExlBook
        .ActiveSheet.Range("A2").CopyFromRecordset Rst
        .Worksheets(1).Range("H2:H" & i).NumberFormat = "$#,##0.00"
        .Worksheets(1).Range("J2:J" & i).NumberFormat = "$#,##0.00"
        .Worksheets(1).Range("L2:L" & i).NumberFormat = "$#,##0.00"

        With .Worksheets(1).Range("N2:N" & i)
            .FormatConditions.AddUniqueValues
            .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
            .FormatConditions(1).DupeUnique = xlDuplicate
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 255
                .TintAndShade = 0
            End With
            .FormatConditions(1).StopIfTrue = False
        End With
    End With

    With ExlApp
        .ActiveWorkbook.SaveAs (strXLS)
    End With

Function_Exit:
    If Not Rst Is Nothing Then
        Rst.Close
        Set Rst = Nothing
    End If
    If Not ExlSheet Is Nothing Then
        Set ExlSheet = Nothing
    End If
    If Not ExlBook Is Nothing Then
        Set ExlBook = Nothing
    End If
    If Not ExlApp Is Nothing Then
        ExlApp.Quit
        Set ExlApp = Nothing
    End If
    Exit Function
Function_Error:
    MsgBox Error$
    Resume Function_Exit
End Function

Open in new window

Saurabh...

Set ExlSheet = ExlBook.Worksheets(1) With ExlSheet.Range("N2:N" & i) .FormatConditions.AddUniqueValues .FormatConditions(.FormatConditions.Count).SetFirstPriority .FormatConditions(1).DupeUnique = xlDuplicate With .FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 End With .FormatConditions(1).StopIfTrue = False End With

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

LVL 59

Saurabh Singh TeotiaCommented: 2015-03-18

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial

MDHowellAuthor Commented: 2015-03-19

Thank you so much! I set it up like this:

Conditional Format Duplicates in Excel from Access

Who is Participating?