VBA to highlight unique values in a row?

[lu_lu_lu_lu_lu]

I'm new to VBA and programming macros. My department and another department deal with personnel, but our databases are not linked. This means that once a week we have to "swap" information - i.e, they send us a spreadsheet with their records, we add in our data and then look for differences. This is stuff like name, address, job title, etc.

The guy I took over from used to do this manually(!). I've managed to write a (not very elegant) macro to copy our data and insert it in alternate columns next to their data (eg,EMPLOYEE NUMBER A, EMPLOYEE NUMER B, NAME A, NAME B, DOB A, DOB B, etc) and format this as a table. I now need a macro that will look across each row and highlight and highlight differences/ unique cells, then move on to the next row. I don't want to create a list of unique cells or delete dupes or anything like that, just change the background colour for the cells that are different/unique. I know that excel has conditional formatting to do this, but it is tedious to have to do this row by row and the format painter had it's own problems.

I used Record Macro to conditionally format one row and got the following:

Sub ConditionalFormat2()
Rows("2:2").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlUnique
With Selection.FormatConditions(1).Font
.Strikethrough = False
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

End Sub


The problem is that sometimes we will only have a handful of records to compare and sometimes we will have hundreds, so I don't always have a set number of rows to go through. I need the macro to repeat each line, then stop when it gets to empty rows. I've also heard that it's best to avoid the select function.

Can anybody help me?

 

[pbornemeier]

The method your company is currently using requires that 2 separate people enter near-duplicate data in 2 separate workbooks then the 2 workbooks have to be reconciled. It would be more efficient for the HR people to have a personnel worksheet then have other departments pull the non-restricted data to their workbooks automatically.

However, if you can't revamp your company procedures, this should help:

Option Explicit

Sub ColorUniquesInEachRow()

    Dim lLastRow As Long
    Dim lLastColumn As Long
    Dim lRowIndex As Long

    
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row   'This finds the last filled cell in column 1 (A)
    
    For lRowIndex = 2 To lLastRow
        lLastColumn = Cells(lRowIndex, Columns.Count).End(xlToLeft).Column
    
        With Range(Cells(lRowIndex, 1), Cells(lRowIndex, lLastColumn))
            .FormatConditions.AddUniqueValues
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
            .FormatConditions(1).DupeUnique = xlUnique
            With .FormatConditions(1).Font
                .Strikethrough = False
                .TintAndShade = 0
            End With
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
            End With
                .FormatConditions(1).StopIfTrue = False
        End With
    Next
 End Sub

 

[lu_lu_lu_lu_lu]

Thank you pbornemeier this worked perfectly.

I agree about the system and I've brought it up. Doesn't look like it will change though, so this is great.

 

[George_Martin_3]

The method your company is currently using requires that 2 separate people enter near-duplicate data in 2 separate workbooks then the 2 workbooks have to be reconciled. It would be more efficient for the HR people to have a personnel worksheet then have other departments pull the non-restricted data to their workbooks automatically.

However, if you can't revamp your company procedures, this should help:

Option Explicit

Sub ColorUniquesInEachRow()

    Dim lLastRow As Long
    Dim lLastColumn As Long
    Dim lRowIndex As Long

    
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row   'This finds the last filled cell in column 1 (A)
    
    For lRowIndex = 2 To lLastRow
        lLastColumn = Cells(lRowIndex, Columns.Count).End(xlToLeft).Column
    
        With Range(Cells(lRowIndex, 1), Cells(lRowIndex, lLastColumn))
            .FormatConditions.AddUniqueValues
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
            .FormatConditions(1).DupeUnique = xlUnique
            With .FormatConditions(1).Font
                .Strikethrough = False
                .TintAndShade = 0
            End With
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
            End With
                .FormatConditions(1).StopIfTrue = False
        End With
    Next
 End Sub

Pbornemeier, I'm currently running this script on a workbook with around 60,000 rows and this is not efficient, I think I'm past the five minute mark.

 

[SpillerBD]

I would smash the two tables against each other using the Data Model. Then add the appropriate value or count from each table to where I might have matching/non-matching records between the two tables.