Count duplicates in several columns

[YasserKhalil]

Hello everyone

In Sheet1 I have range of values in range("B3:F25") .. and I need to do some processes on these values
Manually I copy this range and put it to range("K3:O25") then sort this new range according to the five columns by column K & L & M & N & O
After that I had to extract the duplicates in the five columns and count them
then to extract the duplicates in four columns and count them
then extract the duplicates in three columns and count them
then extract the duplicates in two columns and count them

I have attached the expected and final desired output in columns S:X and leave three blank rows in between each set of results
Thanks advanced for help

[karedog]

Maybe :

Sub Test()
  Dim arr(), c(2 To 5) As New Collection, i As Long, j As Long, p As Long, strKey As String, v
  With Sheets.Add(after:=Sheets(Sheets.Count))
    Sheets("Sheet1").Range("B2").CurrentRegion.Copy .Range("K2")
    With .Range("K2").CurrentRegion
      .Sort key1:=.Columns(4), order1:=xlAscending, key2:=.Columns(5), order2:=xlAscending, header:=xlYes
      .Sort key1:=.Columns(1), order1:=xlAscending, key2:=.Columns(2), order2:=xlAscending, key3:=.Columns(3), order3:=xlAscending, header:=xlYes
      arr = .Value
    End With
    For i = 2 To UBound(arr, 1)
        strKey = arr(i, 1)
        For j = 2 To 5
            strKey = strKey & Chr$(2) & arr(i, j)
            On Error Resume Next
               c(j).Add key:=strKey, Item:=Array(strKey, New Collection)
            On Error GoTo 0
            c(j)(strKey)(1).Add Empty
        Next j
    Next i
    ReDim arr(1 To (UBound(arr, 1) + 2) * 4, 1 To 6)
    For i = 5 To 2 Step -1
        p = p + 1
        arr(p, 1) = "Duplicates In " & i & " Columns"
        arr(p, 6) = "COUNT"
        For Each v In c(i)
            If v(1).Count > 1 Then
               p = p + 1
               arr(p, 1) = v(0)
               arr(p, 6) = v(1).Count
            End If
        Next v
        p = p + 1
    Next i
    With .Range("S2").Resize(p, 6)
      .Value = arr
      .Columns(1).TextToColumns DataType:=xlDelimited, other:=True, otherchar:=Chr$(2)
    End With
  End With
End Sub

[YasserKhalil]

Now I used this fantastic code (deleted all the columns that were put for illustration and got the desired results as expected exactly)

Sub Test()
    Dim arr(), c(2 To 5) As New Collection, i As Long, j As Long, p As Long, strKey As String, v

    arr = Sheets("Sheet1").Range("B2").CurrentRegion.Value

    For i = 2 To UBound(arr, 1)
        strKey = arr(i, 1)
        For j = 2 To 5
            strKey = strKey & Chr$(2) & arr(i, j)
            On Error Resume Next
                c(j).Add Key:=strKey, Item:=Array(strKey, New Collection)
            On Error GoTo 0
            c(j)(strKey)(1).Add Empty
        Next j
    Next i

    ReDim arr(1 To (UBound(arr, 1) + 2) * 4, 1 To 6)

    For i = 5 To 2 Step -1
        p = p + 1
        arr(p, 1) = "Duplicates In " & i & " Columns"
        arr(p, 6) = "COUNT"
        For Each v In c(i)
            If v(1).Count > 1 Then
                p = p + 1
                arr(p, 1) = v(0)
                arr(p, 6) = v(1).Count
            End If
        Next v
        p = p + 1
    Next i

    With Sheets("Sheet1").Range("K2").Resize(p, 6)
        .Value = arr
        .Columns(1).TextToColumns DataType:=xlDelimited, other:=True, otherchar:=Chr$(2)
    End With
End Sub

How can I merge the headers of Duplicates In ... in easier way?

[YasserKhalil]

Hello Mr. Karedog
In fact the words would not be enough to thank you .. You are really wonderful and awesome
Thank you very much for this great help

Just need to get these two lines

c(j).Add Key:=strKey, Item:=Array(strKey, New Collection)

c(j)(strKey)(1).Add Empty

And as for the sort process is it important here? I think it is not important ..
I just put it in the sample file so as to show the manual steps that make the work easier (that's all) but as you in wonderful way stored it in array, I think I will do without this part.. Just tell me if I am right or not

Best and kind regards

[karedog]

You are welcome. Just add/modify the last part of the code :

    With Sheets("Sheet1").Range("K2").Resize(p, 6)
        .Clear
        .Value = arr
        .Columns(1).TextToColumns DataType:=xlDelimited, other:=True, otherchar:=Chr$(2)
        For Each cell In .Columns(1).SpecialCells(xlCellTypeConstants, xlTextValues)
            cell.Resize(, 5).Merge
        Next cell
    End With
End Sub

Regards

[YasserKhalil]

Thank you very much my best tutor ..
Waiting for explaining the two lines I referred to in post #3

[karedog]

c(j).Add Key:=strKey, Item:=Array(strKey, New Collection)

If we only have one collection, say :

  Dim coll as New Collection

then the syntax to add data to the collection would be :

  coll.Add Key:=strKey, Item:=.....

But if we have many collections with uniform structures, we can set array where each of its member is a collection.

It is like you have many variables vs you put them in single array like this :
- Many variables :

  Dim i, j, k
  i = 1
  j = 2
  k = 3

- Using array :

  Dim arr(1 to 3)
  arr(1) = 1
  arr(2) = 2
  arr(3) = 3

The same thing applied to collection, if you have many collections, your code would be like this :
- Many collections :

  Dim FirstColl as New Collection, SecondColl as New Collection, ThirdColl as New Collection
  FirstColl.add Key:=... , Item:= ...
  SecondColl.add Key:=... , Item:= ...
  ThirdColl.add Key:=... , Item:= ...

- Using array :

  Dim coll(1 to 3) as New Collection
  coll(1).add Key:=... , Item:= ...
  coll(2).add Key:=... , Item:= ...
  coll(3).add Key:=... , Item:= ...

---

c(j)(strKey)(1).Add Empty

I have once answer your question about collection inside collection (nested).
Collection can store any kind of variables, arrays, and classes.
So you can :

  coll.add Key:=... , Item:=100                       '--> Store simple value
  coll.add Key:=... , Item:=Array(1,2,3)              '--> Store array
  coll.add Key:=... , Item:=New Collection            '--> Store "child" collection inside collection (like putting smaller box inside big box)
  coll.add Key:=... , Item:=Array(1, New Collection)  '--> Store array, where the second member of the array is a collection

If we want to access an array, we will call it through its index, for example :

  arr = Array(1, 2, 3)
  Debug.Print arr(1)
  arr(1) = "Second"
  Debug.Print arr(1)

So now we put it all together :
- to access the member of single collection, it would be :

  v = coll("TheKey")

- to access the member of arrayed collection, it would be :

  v = coll(3)("TheKey")

- If the value stored in ".item" is an array, to access the member of this array would be :

  v = coll(3)("TheKey")(0)
  v = coll(3)("TheKey")(1)
  v = coll(3)("TheKey")(2)

where (0), (1), (2), etc, is index of the array, just like "arr = Array(1, 2, 3) --> Debug.print arr(1)"

- So to access the child collection of big the collection, the index to be used is 1 (because it is zero based index, created using "Array(strKey, New Collection)" syntax) :

  c(j)(strKey)(1)

- To add some data to this child collection, the syntax is :

  c(j)(strKey)(1).Add "Something..."  'In this case we ".Add Empty", because we only want to count the number of occurences

[YasserKhalil]

That's marvelous and fascinating .. You are a great tutor and I enjoyed this tutorial a lot
Thank you very very much Mr. Karedog
Best and kind regards

[karedog]

You are welcome Mr.Yasser Khalil, glad I can help.

Regards