Code To Find Duplicates And Highlight

[Dazzawm]

Is there a code or formula for when there is matching cells in column C that will then look in column AE and highlight any duplicate values please?

 

[Fluff]

it ran for about an hour and crashed excel

Not really surprising, you should never use entire column references in an array formula. Especially when it;s use for CF which is highly volatile.

 

[Dazzawm]

Not really surprising, you should never use entire column references in an array formula. Especially when it;s use for CF which is highly volatile.

Are you able to come up with a Macro please Fluff?

 

[Legacy 143009]

I thought conditional formatting would be faster. I'll write the code.
One question, Is data on column C always in blocks?

 

[Dazzawm]

I thought conditional formatting would be faster. I'll write the code.
One question, Is data on column C always in blocks?

Ye, a single row or blocks up to about a dozen, could be any amount really.

 

[Dazzawm]

Any luck @Flashbond or @Fluff yet please?

 

[Legacy 143009]

This must do the trick. I can't guarantee the speed:

Sub test()
  Dim d As Object, columnC As Variant, columnAE As Variant, i As Long, j As Long, counter As Long
  Set d = CreateObject("Scripting.Dictionary")
  With Application
  columnC = .Transpose(Intersect(UsedRange, Columns("C")))
  columnAE = .Transpose(Intersect(UsedRange, Columns("AE")))
  End With
  
  For i = 2 To UBound(columnC)
    If columnC(i) = columnC(i - 1) Then
      d.Add columnAE(i - 1), 1
      If d.Exists(columnAE(i)) Then
      counter = 1
        For j = i To UBound(columnC)
          If columnC(i - 1) = columnC(j) Then
            counter = counter + 1
          Else
            Exit For
          End If
        Next
        Cells(i - 1, 3).Resize(counter).Interior.Color = 65535
        d.RemoveAll
        i = j - 1
      End If
    Else
      d.RemoveAll
    End If
  Next
End Sub

 

[Legacy 143009]

BTW, setting ScreenUpdate to false may speed up the process.

Sub test()
  Dim d As Object, columnC As Variant, columnAE As Variant, i As Long, j As Long, counter As Long
  Set d = CreateObject("Scripting.Dictionary")
  With Application
  columnC = .Transpose(Intersect(UsedRange, Columns("C")))
  columnAE = .Transpose(Intersect(UsedRange, Columns("AE")))
  .ScreenUpdating = False
 
  For i = 2 To UBound(columnC)
    If columnC(i) = columnC(i - 1) Then
      d.Add columnAE(i - 1), 1
      If d.Exists(columnAE(i)) Then
      counter = 1
        For j = i To UBound(columnC)
          If columnC(i - 1) = columnC(j) Then
            counter = counter + 1
          Else
            Exit For
          End If
        Next
        Cells(i - 1, 3).Resize(counter).Interior.Color = 65535
        d.RemoveAll
        i = j - 1
      End If
    Else
      d.RemoveAll
    End If
  Next

  .ScreenUpdating = True
  End With
End Sub

 

[Dazzawm]

BTW, setting ScreenUpdate to false may speed up the process.

Sub test()
  Dim d As Object, columnC As Variant, columnAE As Variant, i As Long, j As Long, counter As Long
  Set d = CreateObject("Scripting.Dictionary")
  With Application
  columnC = .Transpose(Intersect(UsedRange, Columns("C")))
  columnAE = .Transpose(Intersect(UsedRange, Columns("AE")))
  .ScreenUpdating = False
 
  For i = 2 To UBound(columnC)
    If columnC(i) = columnC(i - 1) Then
      d.Add columnAE(i - 1), 1
      If d.Exists(columnAE(i)) Then
      counter = 1
        For j = i To UBound(columnC)
          If columnC(i - 1) = columnC(j) Then
            counter = counter + 1
          Else
            Exit For
          End If
        Next
        Cells(i - 1, 3).Resize(counter).Interior.Color = 65535
        d.RemoveAll
        i = j - 1
      End If
    Else
      d.RemoveAll
    End If
  Next

  .ScreenUpdating = True
  End With
End Sub

Got an error on

columnC = .Transpose(Intersect(UsedRange, Columns("C")))

 

[Akuini]

I cant say that was very successful, it ran for about an hour and crashed excel. It was a big file to be fair. Is there a macro that will do the same?

About how many rows is your data in col C?
Another option to try:

Sub Dazzawm_1()
'' section group looping
Dim i As Long, j As Long, n As Long
Dim c As Range, a
Dim t As Double
t = Timer - t
Range("C:C").Interior.Color = xlNone
n = Range("C" & Rows.Count).End(xlUp).Row

For i = 2 To n
    If Len(Cells(i, "C")) > 0 Then
        j = WorksheetFunction.CountIf(Range("C" & i & ":C" & n), Cells(i, "C")) 'case insensitive
'            Debug.Print Cells(i, "A").Resize(j).Address
            a = WorksheetFunction.Unique(Cells(i, "AE").Resize(j))
            If UBound(a) < j Then
                If c Is Nothing Then
                    Set c = Cells(i, "C").Resize(j)
                Else
                    Set c = Union(c, Cells(i, "C").Resize(j))
                End If
            End If
            i = i + j - 1
    End If
Next
c.Interior.Color = vbYellow
Debug.Print "It's done in:  " & Format(Timer - t, "0.00") & " seconds"
End Sub

Book1
	B	C	D																										AD	AE	AF
1
2		G																												a
3		G																												b
4		J																												a
5		K																												b
6		M																												a
7		M																												a
8		M																												b
9		S																												a
10		S																												b
11		S																												c
12		U																												a
13		U																												b
14		U																												a
15
Sheet1

 

[Dazzawm]

About how many rows is your data in col C?
Another option to try:

Sub Dazzawm_1()
'' section group looping
Dim i As Long, j As Long, n As Long
Dim c As Range, a
Dim t As Double
t = Timer - t
Range("C:C").Interior.Color = xlNone
n = Range("C" & Rows.Count).End(xlUp).Row

For i = 2 To n
    If Len(Cells(i, "C")) > 0 Then
        j = WorksheetFunction.CountIf(Range("C" & i & ":C" & n), Cells(i, "C")) 'case insensitive
'            Debug.Print Cells(i, "A").Resize(j).Address
            a = WorksheetFunction.Unique(Cells(i, "AE").Resize(j))
            If UBound(a) < j Then
                If c Is Nothing Then
                    Set c = Cells(i, "C").Resize(j)
                Else
                    Set c = Union(c, Cells(i, "C").Resize(j))
                End If
            End If
            i = i + j - 1
    End If
Next
c.Interior.Color = vbYellow
Debug.Print "It's done in:  " & Format(Timer - t, "0.00") & " seconds"
End Sub

Book1
	B	C	D																										AD	AE	AF
1
2		G																												a
3		G																												b
4		J																												a
5		K																												b
6		M																												a
7		M																												a
8		M																												b
9		S																												a
10		S																												b
11		S																												c
12		U																												a
13		U																												b
14		U																												a
15
Sheet1

Could be anything up to about 150, 000 rows.