count the duplicate entries with the help of Macro

Maybe :

Sub Test()
  Dim coll As New Collection, arrIn, arrOut, i As Long, p As Long, v1, v2

  arrIn = Sheet1.Range("A1").CurrentRegion.Value
  For i = 2 To UBound(arrIn, 1)
      On Error Resume Next
         coll.Add key:=arrIn(i, 2), Item:=Array(arrIn(i, 2), New Collection)
      On Error GoTo 0
      coll(arrIn(i, 2))(1).Add arrIn(i, 3)
  Next i

  ReDim arrOut(1 To UBound(arrIn, 1), 1 To 4)
  p = 1: arrOut(p, 1) = "SYMBOL": arrOut(p, 2) = "COUNT": arrOut(p, 3) = "SYMBOL": arrOut(p, 4) = "DATE"
  For Each v1 In coll
      arrOut(p + 1, 1) = v1(0)
      arrOut(p + 1, 2) = v1(1).Count
      i = 0
      For Each v2 In v1(1)
          p = p + 1
          i = i + 1
          arrOut(p, 3) = v1(0) & "-" & Application.WorksheetFunction.Roman(i)
          arrOut(p, 4) = v2
      Next v2
  Next v1

  Columns("L:O").ClearContents
  Range("L1").Resize(UBound(arrOut, 1), UBound(arrOut, 2)).Value = arrOut
End Sub

You are welcome.
This code will produce unique dates only for each symbol :

Sub Test()
  Dim coll As New Collection, arrIn, arrOut, i As Long, p As Long, v1, v2

  arrIn = Sheet1.Range("A1").CurrentRegion.Value
  For i = 2 To UBound(arrIn, 1)
      On Error Resume Next
         coll.Add key:=arrIn(i, 2), Item:=Array(arrIn(i, 2), New Collection)
         coll(arrIn(i, 2))(1).Add key:=CStr(arrIn(i, 3)), Item:=arrIn(i, 3)
      On Error GoTo 0
  Next i

  ReDim arrOut(1 To UBound(arrIn, 1), 1 To 4)
  p = 1: arrOut(p, 1) = "SYMBOL": arrOut(p, 2) = "COUNT": arrOut(p, 3) = "SYMBOL": arrOut(p, 4) = "DATE"
  For Each v1 In coll
      arrOut(p + 1, 1) = v1(0)
      arrOut(p + 1, 2) = v1(1).Count
      i = 0
      For Each v2 In v1(1)
          p = p + 1
          i = i + 1
          arrOut(p, 3) = v1(0) & "-" & Application.WorksheetFunction.Roman(i)
          arrOut(p, 4) = v2
      Next v2
  Next v1

  Columns("Q:T").ClearContents
  Range("Q1").Resize(UBound(arrOut, 1), UBound(arrOut, 2)).Value = arrOut
End Sub

Hi karedog,
one more help if possible ...can we put that NEW SYMBOL which we create in entire "S" column or some other column ???

sorry for one more query

You are welcome.

I don't catch your newest request, but my guess is you want to remove blank cells in columns Q:R ?
If yes, then run this Sub Test2(), after you run Sub Test().

Sub Test2()
  Range("Q1:R" & Cells(Rows.Count, "Q").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
End Sub

No not like that ...Here I am sending the Screen Shot of what I want ....

Maybe this one :

Sub Test3()
  Dim coll As New Collection, arrIn, arrOut, i As Long, p As Long, v1, v2

  arrIn = Sheet1.Range("A1").CurrentRegion.Value
  For i = 2 To UBound(arrIn, 1)
      On Error Resume Next
         coll.Add key:=arrIn(i, 2), Item:=Array(arrIn(i, 2), New Collection)
         With coll(arrIn(i, 2))(1)
           .Add key:=CStr(arrIn(i, 3)), Item:=Array(arrIn(i, 3), .Count + 1)
         End With
      On Error GoTo 0
  Next i

  ReDim arrOut(1 To UBound(arrIn, 1), 1 To 4)
  p = 1: arrOut(p, 1) = "SYMBOL": arrOut(p, 2) = "COUNT": arrOut(p, 3) = "SYMBOL": arrOut(p, 4) = "DATE"
  For Each v1 In coll
      arrOut(p + 1, 1) = v1(0)
      arrOut(p + 1, 2) = v1(1).Count
      For Each v2 In v1(1)
          p = p + 1
          arrOut(p, 3) = v1(0) & "-" & Application.WorksheetFunction.Roman(v2(1))
          arrOut(p, 4) = v2(0)
      Next v2
  Next v1
  Columns("R:U").ClearContents
  Range("R1").Resize(UBound(arrOut, 1), UBound(arrOut, 2)).Value = arrOut

  ReDim arrOut(1 To UBound(arrIn, 1), 1 To 1)
  For i = 2 To UBound(arrIn, 1)
      v1 = coll(arrIn(i, 2))
      v2 = v1(1)(CStr(arrIn(i, 3)))
      arrOut(i, 1) = v1(0) & "-" & Application.WorksheetFunction.Roman(v2(1))
  Next i
  Range("P1").Resize(UBound(arrOut, 1), UBound(arrOut, 2)).Value = arrOut
End Sub

You are welcome, glad I can help.


Regards

You are right, changing Sheet1 to ActiveSheet, or completly remove the "Sheet1" word (including the dot next to it) will do.

Originally Posted by chirag_patel5141

hi karedog...

how r u ...its a long time and i need your help once again if possible ..

plz look at this query as well :- https://www.excelforum.com/excel-pro...ilter-vba.html

Please do not post requests for help on someone else's thread