VBA option to highlight duplicates in more than one column

Serafin54

Board Regular
Joined
Apr 11, 2014
Messages
137
Office Version
  1. 2016
Platform
  1. Windows
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

NameDateAmountDeduction
John Smith01/01/202110010
Michael Johnson01/02/202150015
Laura White01/02/202190020
Michelle Thomas01/04/2021130025
Michael Johnson01/01/2021170030
Laura White01/06/2021210035
Michelle Thomas01/01/2021250040
John Smith01/04/2021290045
John Smith01/01/202110010
Laura White01/04/2021370055
Michelle Thomas01/01/2021410060
 

Marc L

Banned User
Joined
Apr 5, 2021
Messages
2,030
Office Version
  1. 2010
Platform
  1. Windows
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 …​
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

Gokhan Aycan

Active Member
Joined
Aug 8, 2021
Messages
446
Office Version
  1. 365
Platform
  1. Windows
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

Board Regular
Joined
Apr 11, 2014
Messages
137
Office Version
  1. 2016
Platform
  1. Windows
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".

VBA Code:
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 ! :eek:
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

Board Regular
Joined
Apr 11, 2014
Messages
137
Office Version
  1. 2016
Platform
  1. Windows
Also you can try this version...
VBA Code:
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

Well-known Member
Joined
Nov 11, 2020
Messages
672
Office Version
  1. 2016
Platform
  1. Windows
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

Board Regular
Joined
Apr 11, 2014
Messages
137
Office Version
  1. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Nov 11, 2020
Messages
672
Office Version
  1. 2016
Platform
  1. Windows
With a little addition.
VBA Code:
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
 
Solution

Serafin54

Board Regular
Joined
Apr 11, 2014
Messages
137
Office Version
  1. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Nov 11, 2020
Messages
672
Office Version
  1. 2016
Platform
  1. Windows
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.
 

Forum statistics

Threads
1,175,794
Messages
5,899,529
Members
434,780
Latest member
andreeajc

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top