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

MDHowellAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
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.

Saurabh Singh TeotiaCommented:
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...
0

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:
Thank you so much!  I set it up like this:
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

Open in new window

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.