Highlight duplicate values when two other pairs of cells have matching values

[Rorando]

Greetings!

I'm trying to get find a way to highlight cells so I can see if duplicate values exist during the same day and time. This so I can easily spot these duplicates and change my dates/times in L column to avoid these.

In other words: How to highlight duplicate values in cell range: A1:K12, when L1 & L2 are both matching with any other combination of two cells in L Column, i.e. L4 & L5 / L7 & L8 / L10 & L11

An example here:

D1 & A10 Have duplicate values (33) in the picture. But I only want them highlighted because Their respective L Column values "Mon 13 Jan" & "13.00" match with L10 & L11

A7 & G10 Have duplicate values (39) in the picture, but since both their respective L column values don't match, I Don't want them highlighted.


I hope I am making myself clear enough to get some help in this matter.

All the best // R

 

[DanteAmor]

Hi and welcome to the forum!

Try this macro.

Sub Highlight_duplicate()
  Dim a As Range, c As Range, x As Range, y As Range
  Dim dic1 As Object, dic2 As Object, cad As String
  
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  
  For Each a In Range("L1", Range("L" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
    dic2.RemoveAll
    cad = a.Cells(1).Value & "|" & a.Cells(2).Value
    If dic1.exists(cad) Then
      Set x = Range(dic1(cad)).Offset(0, -11).Resize(3, 11)
      Set y = a.Offset(0, -11).Resize(3, 11)
      For Each c In x.SpecialCells(xlCellTypeConstants)
        If c.Value <> 0 Then
          dic2(c.Value) = c.Address
        End If
      Next
      For Each c In y.SpecialCells(xlCellTypeConstants)
        If c.Value <> 0 Then
          If dic2.exists(c.Value) Then
            c.Interior.Color = vbYellow
            Range(dic2(c.Value)).Interior.Color = vbYellow
          End If
        End If
      Next
    Else
      dic1(cad) = a.Cells(1).Address
    End If
  Next
End Sub

__________________________________

HOW TO INSTALL MACROs
If you are new to macros, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. To use the macro, go back to the worksheet with your data on it and press ALT+F8, select the macro name (Highlight_duplicate) from the list that appears and click the Run button. The macro will execute and perform the action(s) you asked for. If you will need to do this again in this same workbook, and if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "Yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

 

[Rorando]

Thank you for the Macro! I applied it to my example and it worked the first run. I did some testing just to make sure and found some issues. It seems that it doesn't take into account the L column time criteria for it. And when I change the times around, for some reason it misses some new numbers afterward but still painted old non duplicate numbers.

Here's an example with new times and duplicate numbers that it missed (Orange). But the old numbers in yellow still got highlighted even though they have different times now in L2 & L11

Thank you!

// R

 

[DanteAmor]

Before each execution you had to manually remove the color of the cells.
Now I put it in the macro, try again.

Sub Highlight_duplicate()
  Dim a As Range, c As Range, x As Range, y As Range
  Dim dic1 As Object, dic2 As Object, cad As String
  
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  
  Range("A:K").Interior.Color = xlNone
  
  For Each a In Range("L1", Range("L" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
    dic2.RemoveAll
    cad = a.Cells(1).Value & "|" & a.Cells(2).Value
    If dic1.exists(cad) Then
      Set x = Range(dic1(cad)).Offset(0, -11).Resize(3, 11)
      Set y = a.Offset(0, -11).Resize(3, 11)
      For Each c In x.SpecialCells(xlCellTypeConstants)
        If c.Value <> 0 Then
          dic2(c.Value) = c.Address
        End If
      Next
      For Each c In y.SpecialCells(xlCellTypeConstants)
        If c.Value <> 0 Then
          If dic2.exists(c.Value) Then
            c.Interior.Color = vbYellow
            Range(dic2(c.Value)).Interior.Color = vbYellow
          End If
        End If
      Next
    Else
      dic1(cad) = a.Cells(1).Address
    End If
  Next
End Sub

 

[Rorando]

Before each execution, you had to manually remove the color of the cells.
Now I put it in the macro, try again.

I did manually remove the colors, returned the sheet to normal before each run of the macro.
I updated with the new code now and ran again, with the same issues again.

Issue 1:

Cells D1 & E1 have duplicate values with A10 & K10, but their times in L2 & L11, don't match, so they shouldn't be highlighted.

Issue 2:

Cells A7 & B7 have duplicate values with G10 & H10, and their date, as well as times, match in the L columns. So they should get highlighted but are not atm.

I hope I'm making myself understandable with what I'm looking for here.

New code, new run with the issues demonstrated in picture:

Thank you for your understanding.

// R

 

[Peter_SSs]

Are those dates and times in column L real dates and times (Numbers) or are they Text? I ask because usually if a date (number) is formatted to show the month that month would start with an upper case letter.

That is, if you use blank cells on the sheet with these formulas, what do they return?
=ISNUMBER(L1)
=ISNUMBER(L2)

 

[DanteAmor]

View attachment 3659

The problem is that you have merged cells in the L-M-N column.
You could remove those merged cells, maybe you can make the L column wider.
With the data in a single column the macro works fine:

 

[DanteAmor]

If you want to keep your merged cells, then use the following code:

Sub Highlight_duplicate_1()
  Dim a As Range, c As Range
  Dim dic1 As Object, dic2 As Object, cad As String
  
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  
  Range("A:K").Interior.Color = xlNone
  For Each a In Range("L1", Range("L" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
    dic2.RemoveAll
    cad = Cells(a.Cells(1).Row, "L") & "|" & Cells(a.Cells(1).Row + 1, "L")
    If dic1.Exists(cad) Then
      For Each c In Range("A" & dic1(cad)).Resize(3, 11)
        If c.Value <> 0 Then dic2(c.Value) = c.Address
      Next
      For Each c In Range("A" & a.Cells(1).Row).Resize(3, 11)
        If c.Value <> 0 Then
          If dic2.Exists(c.Value) Then
            c.Interior.Color = vbYellow
            Range(dic2(c.Value)).Interior.Color = vbYellow
          End If
        End If
      Next
    Else
      dic1(cad) = a.Cells(1).Row
    End If
  Next
End Sub

But keep in mind that it is not advisable to use merged cells. Check post #9:

How to un-protect multiple cells in Excel worksheet with VBA

Hi, How to un-protect multiple cells in Excel worksheet with coding. I have a worksheet. I need to protect entire worksheet apart from few cells. I tried various solutions from Google but somehow it is not working for me. For example, I want to keep cell A1, B5, C10, D15, E20 unprotected. And...

www.mrexcel.com

 

[Rorando]

Wonderful!

It works well now that I followed your advice and unmerged the cells in the L column. Thanks a lot!

I just came up with a follow-up question. Since I am not super familiar with all the VBA code. Is it possible to apply this to a larger range? I was thinking of expanding this to check for a larger range and dates at the same time, instead of checking new combinations in the same 4 section range all the time. I was thinking maybe 16 Sections of checks at the same time.

Example:

In Response to @Peter_SSs:

The date cells were initially in "Custom" format, and the time in "Time" format, now both are in "Custom". just happened to be so to make the formatting prettier in the beginning. Does it affect the Macro at all?

 

[DanteAmor]

Wonderful!

Is it possible to apply this to a larger range? I was thinking of expanding this to check for a larger range and dates at the same time, instead of checking new combinations in the same 4 section range all the time. I was thinking maybe 16 Sections of checks at the same time.

Of course, you can expand it to hundreds of sections. Only consider the structure of 3 lines per section and in the column of dates you must have the date, time and a blank cell.

I Attach the macro with some changes so you can expand the sections, just update the following data within the macro, they are according to your last example:

cIni = "C" 'start column
cEnd = "W" 'end column
cDat = "X" 'date column
rIni = 4 'start row

Sub Highlight_duplicate_3()
  Dim a As Range, c As Range
  Dim dic1 As Object, dic2 As Object, cad As String
  Dim cIni As String, cEnd As String, cDat As String, rIni
  
  cIni = "C"      'start column
  cEnd = "W"      'end column
  cDat = "X"      'date column
  rIni = 4        'start row
 
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  
  Range(cIni & ":" & cEnd).Interior.Color = xlNone
  For Each a In Range(cDat & rIni, Range(cDat & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
    dic2.RemoveAll
    cad = Cells(a.Cells(1).Row, cDat) & "|" & Cells(a.Cells(1).Row + 1, cDat)
    If dic1.Exists(cad) Then
      For Each c In Range(Cells(dic1(cad), cIni), Cells(dic1(cad) + 2, cEnd))
        If c.Value <> 0 Then dic2(c.Value) = c.Address
      Next
      For Each c In Range(Cells(a.Cells(1).Row, cIni), Cells(a.Cells(1).Row + 2, cEnd))
        If c.Value <> 0 Then
          If dic2.Exists(c.Value) Then
            c.Interior.Color = vbYellow
            Range(dic2(c.Value)).Interior.Color = vbYellow
          End If
        End If
      Next
    Else
      dic1(cad) = a.Cells(1).Row
    End If
  Next
End Sub