VBA option to highlight duplicates in more than one column

[Serafin54]

Hello,

Is there a way to select a range and highlight if there are duplicates in two or more of the selected range? For instance, in the sheet below, though the same 4 people are listed, column A isn't highlighted until there's a secondary match in B then again in C and D. I know a helper column can be used but looking to see if there's a macro that can be run to speed up the task as it is daily and sometimes 2 to 3 times per.

The caveat is that this would need to be selection range based

Name	Date	Amount	Deduction
John Smith	01/01/2021	100	10
Michael Johnson	01/02/2021	500	15
Laura White	01/02/2021	900	20
Michelle Thomas	01/04/2021	1300	25
Michael Johnson	01/01/2021	1700	30
Laura White	01/06/2021	2100	35
Michelle Thomas	01/01/2021	2500	40
John Smith	01/04/2021	2900	45
John Smith	01/01/2021	100	10
Laura White	01/04/2021	3700	55
Michelle Thomas	01/01/2021	4100	60

 

[Marc L]

I guess it is a convenience issue here.

In fact he just had the bad idea to ask to work specificly on the selection instead of the used range which does very not need to select anything …​

 

[Gokhan Aycan]

That still doesn't give you an option between Selection and UsedRange though. With Selection route and the change I mentioned, you can either select a small region or simply select a column to process the UsedRange, which I believe is a good thing.

 

[Serafin54]

I guess it is a convenience issue here. Code can be modified as "If you select an entire column, just use UsedRange, or perhaps CurrentRegion".

If Selection.Rows.Count = Columns("A:A").Rows.Count Then
    Set vRng = ActiveSheet.UsedRange
Else
    Set vRng = Selection
End If

@Serafin54 You can also quickly select all connected cells by CTRL + * after selecting any cell with data.

I usually use Ctrl+A but that combo might be a little more natural feeling. And your correct on the convenience. sometimes there could be blank cells in the first column so it's either manually scroll and select or CTRL Shift down until i bypass them all

As you asked to work with the selection so it's the worst idea to select entire columns ! ​

As the end of the range is the end of the selection aka row #1 048 576 since Excel 2007 …​

And yes. I'm aware of the reasoning and though I am ok with it, this code is being built into an add in so that temp workers during the holiday season can quickly jump in and unfortunately they don't come in with much excel exposure.

 

[Serafin54]

Also you can try this version...

Sub HighLightSelectionRowsDuplicates()
  
    Dim vRng As Range
    Dim vR As Long
    Dim vC As Integer
    Dim vN1 As Long, vN2 As Long
    Dim vColored As Boolean
    Dim vS As String
  
    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.Interior.Color = xlNone
    Set vRng = Selection
    vR = vRng.Rows.Count
    vC = vRng.Columns.Count
    vA1 = vRng
    ReDim vA2(1 To vR, 1 To 2)
    For vN1 = 1 To vR
        For vN2 = 1 To vC
            vS = vS & vA1(vN1, vN2)
        Next vN2
        vA2(vN1, 1) = vS
        vA2(vN1, 2) = vS
        vS = ""
    Next vN1
    For vN1 = 1 To vR - 1
        For vN2 = vN1 + 1 To vR
            If vA2(vN1, 1) = vA2(vN2, 2) Then
                vRng.Range(Cells(vN2, 1), Cells(vN2, vC)). _
                    Interior.Color = vbYellow
                vColored = True
            End If
        Next vN2
        If vColored = True Then _
            vRng.Range(Cells(vN1, 1), Cells(vN1, vC)). _
                Interior.Color = vbYellow
            vColored = False
    Next vN1

End Sub

[/QUOTE]

Thank you Excel Max. Not sure the difference in the two codes but this one works nicely.

​

 

[EXCEL MAX]

I'm glad that you found a solution. This is difference.
First version of code concatenate values from each cell in a one row to a string.
After that code highlights duplicates only in the selected range.
The last version of code concatenate values from each cell in a one row,
but only in selected range,
also highlights duplicates only in the selected range.

 

[Serafin54]

I'm glad that you found a solution. This is difference.
First version of code concatenate values from each cell in a one row to a string.
After that code highlights duplicates only in the selected range.
The last version of code concatenate values from each cell in a one row,
but only in selected range,
also highlights duplicates only in the selected range.

Is there a way to add code to it so if you select the columns themselves the code only runs to the last row of data in those columns and not past and all the way 1million blanks down to the end of the sheet? This would be in the second code you created as that one does what is needed, beautifully.

 

[EXCEL MAX]

With a little addition.

Sub SelectColumnsHighLightRowsDuplicates()
  
    Dim vRng As Range
    Dim vR As Long, vRMax As Long, vCMax As Long
    Dim vC As Integer
    Dim vN1 As Long, vN2 As Long
    Dim vColored As Boolean
    Dim vS As String

    Application.ScreenUpdating = False
    ActiveSheet.UsedRange.Interior.Color = xlNone
    Set vRng = Selection
    vR = vRng.Rows.Count
    vC = vRng.Columns.Count

    If vR = Cells.Rows.Count Then
        For vN = 1 To vRng.Columns.Count
            vR = Cells(Rows.Count, vRng.Cells(1, vN).Column).End(xlUp).Row
            If vR > vRMax Then vRMax = vR
            vR = vRMax
        Next vN
    End If
    If vC = Cells.Columns.Count Then
        For vN = 1 To vRng.Rows.Count
            vC = Cells(vRng.Cells(vN, 1).Row, Columns.Count).End(xlToLeft).Column
            If vC > vCMax Then vCMax = vC
            vC = vCMax
        Next vN
    End If
    
    Set vRng = vRng.Resize(vR, vC)
    vRng.Select  'this line is optional
    vA1 = vRng
    ReDim vA2(1 To vR, 1 To 2)
    For vN1 = 1 To vR
        For vN2 = 1 To vC
            vS = vS & vA1(vN1, vN2)
        Next vN2
        vA2(vN1, 1) = vS
        vA2(vN1, 2) = vS
        vS = ""
    Next vN1
    For vN1 = 1 To vR - 1
        For vN2 = vN1 + 1 To vR
            If vA2(vN1, 1) = vA2(vN2, 2) And Not vA2(vN1, 1) = "" Then
                vRng.Range(Cells(vN2, 1), Cells(vN2, vC)). _
                    Interior.Color = vbYellow
                vColored = True
            End If
        Next vN2
        If vColored = True Then _
            vRng.Range(Cells(vN1, 1), Cells(vN1, vC)). _
                Interior.Color = vbYellow
            vColored = False
    Next vN1

End Sub

 

[Serafin54]

This is the holy grail right here. Beautiful code. works exactly as I could have expected. Thank you so much!!!! Was it just adding in the vRMax and vCMax codes?

 

[EXCEL MAX]

The added part of code have this sence...
In a case the max workseet rows is detected
code goes through each column and measuring number of the rows.
If the number of the rows in some column is greater than a remembered max row, it becomes max value.
Same thing is repeated for a rows.
Now you get new "vC" and "vR" variable values.
The rest of code is the same.