Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Test for dups in Array
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Test for dups in Array
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. -- steveB Remove "AYN" from email to respond "Perico" wrote in message ... 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Test for dups in Array
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 "Perico" wrote in message ... 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Test for dups in Array
Very cool code. Thanks very much.
"KL" wrote: 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 "Perico" wrote in message ... 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Test for dups in Array
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" wrote: 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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Test for dups in Array
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
logical test, array, text and numbers | Excel Worksheet Functions | |||
Array Test | Excel Programming | |||
Test for end of array of objects? | Excel Programming | |||
Test for Single Character That is in an Array | Excel Worksheet Functions |