count the duplicate entries with the help of Macro

C

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>
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Sort by date Sort by votes
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
 
Upvote 0
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!
 
Upvote 0
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
 
Upvote 0
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 ...
 
Upvote 0
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 ....
 
Upvote 0
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
 
Upvote 0
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>
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
Assign Month number 1 to n based on sequential week range
Replies
6
Views
243
amolvijay
A
ExcelNewbie2020
  • Solved
transpose data
2
Replies
15
Views
170
kvsrinivasamurthy
K
W
  • Solved
Number of times a name appears against separate dates
Replies
3
Views
230
Fluff
Fluff
K
  • Question
Auto Sort (Descinding) based on a column header using VBA
Replies
1
Views
86
Fluff
Fluff
M
  • Solved
Need help VBA modify that find (x) number if not find 1 lower?
Replies
3
Views
211
motilulla
M

Forum statistics

Threads
1,214,651
Messages
6,120,738
Members
448,988
Latest member
BB_Unlv

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top