We help IT Professionals succeed at work.

Conditional Format Duplicates in Excel from Access

MDHowell
MDHowell asked
on
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

Comment
Watch Question

View Solution Only

Top Expert 2015
Commented:
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...
MDHowell

Author

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