Test for dups in Array

[Guest]

I need help on how do I test for duplicate values in an array, x()?

My code so far:

Sub finddups()
Dim mstrWks As Worksheet
Dim myRng As Range
Dim x(), i As Long, j As Long
Set mstrWks = Worksheets("Master")

With mstrWks
Set myRng = .Range("b28", .Cells(.Rows.Count, "B").End(xlUp))
End With

j = myRng.Rows.Count
i = 1
With myRng
For j = 1 To j
ReDim x(j)
x(j) = .Cells(i, 1) & .Cells(i, 2) & .Cells(i, 3) & .Cells(i, 7)
i = i + 1
Next j
End With
End Sub

 

[STEVE BELL]

As a general case I like to test for dupes with
Countif(Range(A:A),cellvalue)
either as a formula in a cell, criteria in Conditional Formating,
restriction in Data > Validation, or
in code.

 

[KL]

Hi Perico,

How about something like this:

Sub finddups()
Dim c As Range
Dim D As Object
Dim Values As Variant
Dim Times As Variant
Set D = CreateObject("Scripting.Dictionary")
With Worksheets("Master")
For Each c In .Range("b28", .Cells(.Rows.Count, "B").End(xlUp))
MyStr = c & c.Offset(, 1) & c.Offset(, 2) & c.Offset(, 6)
If D.Exists(MyStr) Then
D.Item(MyStr) = D.Item(MyStr) + 1
Else
D.Add MyStr, 1
End If
Next c
With Application
Values = .Transpose(D.Keys)
Times = .Transpose(D.Items)
End With
.Range("K28").Resize(UBound(Values)) = Values
.Range("L28").Resize(UBound(Values)) = Times
End With
End Sub


Regards,
KL

 

[Guest]

Very cool code. Thanks very much.

Hi Perico,

How about something like this:

Sub finddups()
Dim c As Range
Dim D As Object
Dim Values As Variant
Dim Times As Variant
Set D = CreateObject("Scripting.Dictionary")
With Worksheets("Master")
For Each c In .Range("b28", .Cells(.Rows.Count, "B").End(xlUp))
MyStr = c & c.Offset(, 1) & c.Offset(, 2) & c.Offset(, 6)
If D.Exists(MyStr) Then
D.Item(MyStr) = D.Item(MyStr) + 1
Else
D.Add MyStr, 1
End If
Next c
With Application
Values = .Transpose(D.Keys)
Times = .Transpose(D.Items)
End With
.Range("K28").Resize(UBound(Values)) = Values
.Range("L28").Resize(UBound(Values)) = Times
End With
End Sub


Regards,
KL

 

[Guest]

KL - your code is superb. I'm pushing the envelope, but if when the array is
written to a sheet in the lines:
.Range("K28").Resize(UBound(Values)) = Values
..Range("L28").Resize(UBound(Values)) = Times
I want to put in cell J28...Jn the value of c.offset(,-1), which is not
picked up by mystr as part of the item, that's not doable is it? I have
sequential line numbers in
c.offset(,-1), so I obviously can't use them in mystr to find dups. But
when the array is written showing VALUE and TIMES, I think I'll have to use
yet another associative array to list the line numbers where TIMES is > 1.
Any thoughts on that?

 

[KL]

Hi Perico,

Try this one.

Regards,
KL

Sub finddups()
Dim j As Long, rng As Range, test As Variant
Dim Values As Variant, Times As Variant
Dim MyStr As String, c As Range, sLine As Variant

With Worksheets("Master")
For Each c In .Range("B28", .Cells(.Rows.Count, "B").End(xlUp))
MyStr = c & c.Offset(, 1) & c.Offset(, 2) & c.Offset(, 6)
If j = 0 Then
test = CVErr(xlErrNA)
ReDim Values(1 To 1)
ReDim Times(1 To 1)
ReDim sLine(1 To 1)
Else
test = Application.Match(MyStr, Values, 0)
End If
If IsError(test) Then
j = j + 1
ReDim Preserve Values(1 To j)
ReDim Preserve Times(1 To j)
ReDim Preserve sLine(1 To j)
Values(j) = MyStr
Times(j) = 1
sLine(j) = c.Offset(, -1)
Else
Times(test) = Times(test) + 1
sLine(test) = sLine(test) & ", " _
& c.Offset(, -1)
End If
Next c
.Range("J28").Resize(UBound(Values)) = _
Application.Transpose(sLine)
.Range("K28").Resize(UBound(Values)) = _
Application.Transpose(Values)
.Range("L28").Resize(UBound(Values)) = _
Application.Transpose(Times)
End With
End Sub