PDA

View Full Version : need help leaning or restructuring macro for highlighighting duplicates on large data



estatefinds
08-09-2018, 04:46 AM
Option Explicit
Sub DupFinder()
Dim R As Range, t As Range

Set t = Range("C5:G16")

For Each R In t.SpecialCells(xlCellTypeConstants).Cells
If Application.WorksheetFunction.CountIf(t, R.Value) > 1 Then
R.Interior.ColorIndex = 3
End If
Next
End Sub




The current code owrks but noticed when i ran it it would hang up and I could'nt even use ESC to interupt it. I need it to run leaner and faster on large data. I also noticed that it highlighted a Duplicate 1-1-1-1-14 when it saw another that was close to a duplicate but not a match to 1-1-1-1-11. It’s like it matched up to the first part of the last number.

The example i attached shows data in column C E G but the data im using is in columns C5:G324632. dis regard data in column E.


if possible a macro that works when I enter a range to find (highlight duplicates in red) duplicates.

any help on this is appreciated
Sincerely,
Dennis

mana
08-09-2018, 06:53 AM
Sub test()


With Columns("C:G").FormatConditions
.Delete
.Add( _
Type:=xlExpression, _
Formula1:="=AND(C1<>"""",COUNTIF($C:$G,C1)>1)" _
).Interior.ColorIndex = 3
End With


End Sub

estatefinds
08-09-2018, 08:17 AM
I ran it but the code is placing the color red where they belong but some are off the data below the data.


also note the data in column C starts at row 5 and continues to about row 9000and the data in column G starts at row 5 and continues all the way down to 324632. The data in the file attached is just a small example as the one I’m using isto big to attach.


Sub DupFinder()Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False


Dim R As Range, t As Range


Set t = Range("C5:G324636")

For Each R In t.SpecialCells(xlCellTypeConstants).Cells
If Application.WorksheetFunction.CountIf(t, R.Value) > 1 Then
R.Interior.ColorIndex = 3
End If
Next

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub




Itried this and disabled all background running programs and still its slow.
need help to lean this macro please

Paul_Hossler
08-09-2018, 06:40 PM
see if something like this is faster





Option Explicit
Sub DupFinder()
Dim rData As Range, rArea As Range, rCell As Range
Dim aryData() As Variant, aryAddr() As String
Dim i As Long

Application.ScreenUpdating = False

Set rData = Range("C5:G23").SpecialCells(xlCellTypeConstants)
rData.ClearFormats

ReDim aryData(1 To rData.Cells.Count)
ReDim aryAddr(1 To rData.Cells.Count)

i = 1
For Each rArea In rData.Areas
For Each rCell In rArea.Cells
aryData(i) = rCell.Value
aryAddr(i) = rCell.Address
i = i + 1
Next
Next

For i = 1 To rData.Cells.Count
If Application.Count(Application.Match(aryData, Array(aryData(i)), 0)) > 1 Then
Range(aryAddr(i)).Interior.Color = vbRed
End If
Next i
Application.ScreenUpdating = True
End Sub

estatefinds
08-10-2018, 03:24 AM
I had run it and it had matched one combination in column C with 5 combination in column G but it colored them red but only cause it match the first 3 numbers of the combination. it needs to be eact match of to be a duplicate. if its 1-1-1-2-3 then it should only be colored red 1-1-1-2-3 not 1-1-1-3-3. let me know if this helps.

The columns of data are different lengths.




Thank you

estatefinds
08-10-2018, 11:44 AM
I also noticed when i change the range to for data to "C5:G324636" i get a message box that says mismatch.