count the duplicate entries with the help of Macro

chirag_patel5141

New Member
Joined
Jun 4, 2016
Messages
10
Hi All,
I want to Count the Duplicate entries in the column "SYMBOL" with the refeance of column "EXPIRY_DT" and also want to number them like...
IF 31-Mar-16 than BANKNIFTY-I , 28-Apr-16 than BANKNIFTY-II & 26-MAY-16 than BANKNIFTY-III


INSTRUMENT"SYMBOL""EXPIRY_DT"OPENHIGHLOWCLOSEOPEN_INTCHG_IN_OI"TIMESTAMP"
FUTIDXBANKNIFTY31-Mar-161574515965.71574015941.55235035019428021-Mar-16
FUTIDXBANKNIFTY28-Apr-1615816160361581616017.552942102301021-Mar-16
FUTIDXBANKNIFTY26-May-1615876.116049.951585016042.9510449084021-Mar-16
FUTIDXDJIA13-Apr-161746017512.51744017507.516950306021-Mar-16
FUTIDXDJIA20-May-16000167400021-Mar-16
FUTIDXDJIA17-Jun-160001638530021-Mar-16
FUTIDXDJIA16-Sep-1600016702.530021-Mar-16
FUTIDXDJIA16-Dec-16000188350021-Mar-16
FUTIDXDJIA17-Mar-17000189650021-Mar-16
FUTIDXFTSE10013-Apr-166398639863986398757521-Mar-16
FUTIDXFTSE10020-May-1600060910021-Mar-16
FUTIDXFTSE10017-Jun-1600072420021-Mar-16
FUTIDXFTSE10016-Sep-1600066370021-Mar-16
FUTIDXFTSE10016-Dec-1600065700021-Mar-16
FUTIDXFTSE10017-Mar-1700067280021-Mar-16
FUTIDXNIFTY31-Mar-167623.57723.27615.27713.3521508425-75180021-Mar-16
FUTIDXNIFTY28-Apr-167664.97761.47658.47750.8429090039157521-Mar-16
FUTIDXNIFTY26-May-167677.457773.47672.157763.710754257777521-Mar-16
FUTIDXNIFTYINFRA31-Mar-160002565150021-Mar-16
FUTIDXNIFTYINFRA28-Apr-160002440.950021-Mar-16
FUTIDXNIFTYINFRA26-May-160002330.450021-Mar-16

<tbody>
</tbody>
 

Some videos you may like

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

chirag_patel5141

New Member
Joined
Jun 4, 2016
Messages
10
the best solution I got till now is like this but its still not proper ... I have to run this macro in three part ..can someone make it in a single part ???

Thanx in Advance

Sub Part1()
'this macro is for numbering the duplicate value
Dim Rng As Range
Dim Dn As Range
Set Rng = Range(Range("B1"), Range("B" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
If Not .Exists(Dn.Value) Then
.Add Dn.Value, 0
Else
If .Item(Dn.Value) = 0 Then
.Item(Dn.Value) = .Item(Dn.Value) + 1
Dn.Value = Dn.Value & "-" & WorksheetFunction.Roman(2, 0)
End If
End If
Next Dn
End With
Application.Run ("Part2")
End Sub
Sub Part2()
Dim Rng As Range
Dim Dn As Range
Set Rng = Range(Range("B1"), Range("B" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
If Not .Exists(Dn.Value) Then
.Add Dn.Value, 0
Else
If .Item(Dn.Value) = 0 Then
.Item(Dn.Value) = .Item(Dn.Value) + 1
Dn.Value = Dn.Value & "-" & WorksheetFunction.Roman(3, 0)
End If
End If
Next Dn
End With
Application.Run ("Part3")
End Sub
Sub Part3()
Dim Rng As Range
Dim Dn As Range
Set Rng = Range(Range("B1"), Range("B" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
If Not .Exists(Dn.Value) Then
.Add Dn.Value, 0
Else
If .Item(Dn.Value) = 0 Then
.Item(Dn.Value) = .Item(Dn.Value) + 1
Dn.Value = Dn.Value & "-" & WorksheetFunction.Roman(4, 0)
End If
End If
Next Dn
End With
End Sub
 

S.H.A.D.O.

Well-known Member
Joined
Sep 6, 2005
Messages
1,915
Hi chirag_patel5141, welcome to the board.

Untested, but maybe something like this...

Code:
Sub Part1()
'   This macro is for numbering the duplicate value.
    Dim Rng As Range
    Dim Dn As Range
    Set Rng = Range(Range("B1"), Range("B" & Rows.Count).End(xlUp))
    With CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
        For Each Dn In Rng
            If Not .Exists(Dn.Value) Then
                .Add Dn.Value, 0
            Else
                If .Item(Dn.Value) = 0 Then
                    .Item(Dn.Value) = .Item(Dn.Value) + 1
'                   Dn.Value = Dn.Value & "-" & WorksheetFunction.Roman(2, 0)
                   Dn.Value.Resize(3, 0) = Dn.Value & "-" & WorksheetFunction.Roman(2, 0)
                End If
            End If
        Next Dn
    End With
End Sub
I hope this helps!
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG05Jun25
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                .Add Dn.Value, Dn
            [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] Dn
    
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, p [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    c = 0
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] .Item(K)
         [COLOR="Navy"]If[/COLOR] .Item(K).Count > 1 [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            p = p & "-" & WorksheetFunction.Roman(c)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] p
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

chirag_patel5141

New Member
Joined
Jun 4, 2016
Messages
10
Hi S.H.A.D.O. ,

tnx for ur effort but that code does not work
 

chirag_patel5141

New Member
Joined
Jun 4, 2016
Messages
10
Hi Mick,

tnx for ur time and effort, your code work but the problem I face is my data base is Big and Symbol of BANKNIFTY comes more than 100 times in that database ...so ur code keep counting that SYMBOL. But If u consider "
EXPIRY_DT" column which is 31-Mar-16 , 28-Apr-16 & 26-May-16 than BANKNIFTY Symbol comes only 3 times in that Database so the BANKNIFTY count will be BANKNIFTY-I, BANKNIFTY-II & BANKNIFTY-III only ...
 

chirag_patel5141

New Member
Joined
Jun 4, 2016
Messages
10
Hi Mick,

Same with the SYMBOL DJIA as well ...that symbol also comes more than 100 times but if u consider "EXPIRY_DT" column than DJIA symbol comes only 6 times so I want a result like DJIA-I,DJIA-II,DJIA-III,DJIA-IV,DJIA-V & DJIA-VI...Same with SYMBOL "FTSE100" ...it also comes only 6 times ...NIFTY Symbol comes only 3 times...So I want result for NIFTY is like NIFTY-I,NIFTY-II & NIFTY-III ....
 

chirag_patel5141

New Member
Joined
Jun 4, 2016
Messages
10
I am not able to post attachments otherwise I will post my Excel file here for ur reference so that U can Help me :)
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this:-
This code will start the count again where a Name from the "SYMBOL" column repeats but is not part of the Previous group.
If this does not work for you , please show an example of the expected result for, for multi ranges of the same "Symbol" name.
Code:
[COLOR="Navy"]Sub[/COLOR] MG06Jun50
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                .Add Dn.Value, Dn
            [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] Dn
    
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, p [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] .Item(K).Areas
         c = 0
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] p
          [COLOR="Navy"]If[/COLOR] .Item(K).Count > 1 [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            R = R & "-" & WorksheetFunction.Roman(c)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] R
    [COLOR="Navy"]Next[/COLOR] p
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

chirag_patel5141

New Member
Joined
Jun 4, 2016
Messages
10
Here is the Original Database.....

INSTRUMENTSYMBOLEXPIRY_DTSTRIKE_PROPTION_TYPOPENHIGHLOWCLOSESETTLE_PRCONTRACTSVAL_INLAKHOPEN_INTCHG_IN_OITIMESTAMP
FUTIDXBANKNIFTY30-Jun-160XX17624.417738.51761517655.8517655.8577226409560.71724790-3969003-Jun-16
FUTIDXBANKNIFTY28-Jul-160XX17740178001771017725.717725.79236554.3686000136003-Jun-16
FUTIDXBANKNIFTY25-Aug-160XX177991786017780178001780044313.69548012003-Jun-16
OPTIDXBANKNIFTY30-Jun-1614000CE36173665.253600.5360836081789.9454120-24003-Jun-16
OPTIDXBANKNIFTY30-Jun-1614500CE3111.23111.23111.23111.23111.215.2881903003-Jun-16
OPTIDXBANKNIFTY30-Jun-1615000CE2650.326802650.32668.052668.0544233.227570129003-Jun-16
OPTIDXBANKNIFTY30-Jun-1615500CE2227.852227.8521892190.852190.85315.9327900003-Jun-16
OPTIDXBANKNIFTY30-Jun-1615700CE1964.151964.151964.151964.151964.1515.2990003-Jun-16
OPTIDXBANKNIFTY30-Jun-1616000CE16991730.116601660166060318.545388042003-Jun-16
OPTIDXBANKNIFTY30-Jun-1616100CE1561.81561.81561.81561.81561.815.29603003-Jun-16
OPTIDXBANKNIFTY30-Jun-1616300CE1444.41444.41444.41444.41444.415.32240003-Jun-16
OPTIDXBANKNIFTY30-Jun-1618600PE1017.11017.11017.11017.11017.115.88990003-Jun-16
OPTIDXBANKNIFTY28-Jul-1616000CE171017901710179017901178.04688044003-Jun-16
OPTIDXBANKNIFTY28-Jul-1617500CE650675650675675643.5952020003-Jun-16
OPTIDXBANKNIFTY28-Jul-1618000CE398.65399372.4377.65377.65858.84312016003-Jun-16
OPTIDXBANKNIFTY28-Jul-1615000PE42443737371166.1752012003-Jun-16
OPTIDXBANKNIFTY28-Jul-1616000PE949786.289.5589.5534218.87552016003-Jun-16
OPTIDXBANKNIFTY28-Jul-1616500PE141141140140140319.96320-8003-Jun-16
OPTIDXBANKNIFTY28-Jul-1617000PE277.2277.2236.15256256748.3164012003-Jun-16
OPTIDXBANKNIFTY28-Jul-1617500PE50050050050050017.2404003-Jun-16

<colgroup><col><col><col><col span="12"></colgroup><tbody>
</tbody>


And I want to Change SYMBOL Column in New Database like this ...

INSTRUMENTSYMBOLEXPIRY_DTSTRIKE_PROPTION_TYPOPENHIGHLOWCLOSESETTLE_PRCONTRACTSVAL_INLAKHOPEN_INTCHG_IN_OITIMESTAMP
FUTIDXBANKNIFTY-I30-Jun-160XX17624.417738.51761517655.8517655.8577226409560.71724790-3969003-Jun-16
FUTIDXBANKNIFTY-II28-Jul-160XX17740178001771017725.717725.79236554.3686000136003-Jun-16
FUTIDXBANKNIFTY-III25-Aug-160XX177991786017780178001780044313.69548012003-Jun-16
OPTIDXBANKNIFTY-I30-Jun-1614000CE36173665.253600.5360836081789.9454120-24003-Jun-16
OPTIDXBANKNIFTY-I30-Jun-1614500CE3111.23111.23111.23111.23111.215.2881903003-Jun-16
OPTIDXBANKNIFTY-I30-Jun-1615000CE2650.326802650.32668.052668.0544233.227570129003-Jun-16
OPTIDXBANKNIFTY-I30-Jun-1615500CE2227.852227.8521892190.852190.85315.9327900003-Jun-16
OPTIDXBANKNIFTY-I30-Jun-1615700CE1964.151964.151964.151964.151964.1515.2990003-Jun-16
OPTIDXBANKNIFTY-I30-Jun-1616000CE16991730.116601660166060318.545388042003-Jun-16
OPTIDXBANKNIFTY-I30-Jun-1616100CE1561.81561.81561.81561.81561.815.29603003-Jun-16
OPTIDXBANKNIFTY-I30-Jun-1616300CE1444.41444.41444.41444.41444.415.32240003-Jun-16
OPTIDXBANKNIFTY-I30-Jun-1618600PE1017.11017.11017.11017.11017.115.88990003-Jun-16
OPTIDXBANKNIFTY-II28-Jul-1616000CE171017901710179017901178.04688044003-Jun-16
OPTIDXBANKNIFTY-II28-Jul-1617500CE650675650675675643.5952020003-Jun-16
OPTIDXBANKNIFTY-II28-Jul-1618000CE398.65399372.4377.65377.65858.84312016003-Jun-16
OPTIDXBANKNIFTY-II28-Jul-1615000PE42443737371166.1752012003-Jun-16
OPTIDXBANKNIFTY-II28-Jul-1616000PE949786.289.5589.5534218.87552016003-Jun-16
OPTIDXBANKNIFTY-II28-Jul-1616500PE141141140140140319.96320-8003-Jun-16
OPTIDXBANKNIFTY-II28-Jul-1617000PE277.2277.2236.15256256748.3164012003-Jun-16
OPTIDXBANKNIFTY-II28-Jul-1617500PE50050050050050017.2404003-Jun-16

<colgroup><col><col><col><col span="12"></colgroup><tbody>
</tbody>
 

Watch MrExcel Video

Forum statistics

Threads
1,095,172
Messages
5,442,822
Members
405,198
Latest member
Florence Thomas

This Week's Hot Topics

  • Copy entire row if CountA <>0 to another sheet
    [B]I want to copy entire row if CountA <>0 for column J7:AM7 (headers on J6:AM6) and so on till the last used cell is column D and paste the...
  • Select last used Row in Table
    I have created a Table in a Worksheet which is locked to prevent user errors and protect formula. Some of the cells require freetext entries which...
  • excel workbook: do not allow certain file name
    Hello all, Don't think this has ever been asked before, but how do I restrict file save [Before_Save Event] if the name of the file being saved...
  • fixing problem autofilter
    hello i need help about my code when i search by code in textbox it doesn't show anything this is my data [ATTACH type="full"...
  • “Weight”
    Hi, i’ve got a long sheet filled with weights such as kg,g,L & ml. i can build a formula to convert kg into g and liter into ml. How ever, my...
  • How to capitalize everything before a certain character?
    In column A, I have some text: Hello good day.mp3 Hello good day.flac etc. I'd like to capitalize everything before the period. I don't need the...
Top