Counting duplicates in a list according to dates

[weilun]

Dear all,

Please help me. I cant find a solution to this. I have a list with names and they are categorized with dates. I need to count the number of duplicates that appears:


-- removed inline image ---
TOM 12/14/2011 TOM 2 12/14/2011
TOM 12/14/2011
SERENE 12/13/2011 SERENE 1 12/13/2011
GILL 12/13/2011 GILL 2 12/13/2011
GILL 12/13/2011

I know the normal way of counting duplicates but how to do it with dates? the whole spreadsheet would contain different dates and sometimes the number of names changes daily. Please help!

 

[weilun]

Hi,

Thanks for your help but i got a debug at the last line Range("D2").Resize(.Count, 3) = Application.Transpose(Application.Transpose(.Items))

Any ideas why this happens?

Thanks for your help...

Hey, it works. I debug it...

It works just fine! Thanks alot for your help! u saved me...!

 

[Aladin Akyurek]

Not too sure what do u mean by data area. Do you mean that the amount of data can vary? if this is what u meant, then yes. sometimes it can be a 100 names and sometimes 200 names with different days.

Yes, that's what I meant.

I personally think it is quite a challenge and realli can't think of anything to deal with it. this extremely important to me. I thank you for trying to help me... I'm not sure if an array will help me? I'm not too sure how to do an array too..

The pivot table approach is ideal for this. Even code in VBA. But, a formula approach is not impossible. What is the Excel version you are on?

 

[leprince2OO7]

Mike
please could you give us small explanation about these lines

.Add Twn, Array(Dn, Dn.Offset(, 1), 1)
                Else
                    Q = .Item(Twn)
                    Q(2) = Q(2) + 1
                    .Item(Twn) = Q

 

[MickG]

This may help:-

[COLOR=navy]Sub[/COLOR] MG26Dec20
'[COLOR=green][B]This may help:-[/B][/COLOR]
'[COLOR=green][B]The "Twn" variable is the "Key" for each Unique "Value/Offset(,1).value"[/B][/COLOR]
'[COLOR=green][B]Array(Dn, Dn.Offset(, 1), 1)is the "item" for the Unique "Key" (Twn)[/B][/COLOR]
'[COLOR=green][B]Consisting of the "Array":-Column "A" value, Column "B" value and column "C" value[/B][/COLOR]
.Add Twn, Array(Dn, Dn.Offset(, 1), 1)
                [COLOR=navy]Else[/COLOR]
  '[COLOR=green][B]Q is a Variant Variable representing the "Items" Array (as above)[/B][/COLOR]
                    Q = .Item(Twn)
    '[COLOR=green][B]As Duplicates of each unique Key are found, the value of[/B][/COLOR]
    '[COLOR=green][B]the last value in the "Items" array is increased by "1"[/B][/COLOR]
     '[COLOR=green][B]Q(2) is the last value in the "Item" Array[/B][/COLOR]
                    Q(2) = Q(2) + 1
    '[COLOR=green][B]The line below puts the Modified values back in the[/B][/COLOR]
    '[COLOR=green][B]original array for that item.[/B][/COLOR]
                    .Item(Twn) = Q
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[leprince2OO7]

it is great Mike
thank you

 

[jeffreybrown]

Hello Mick,

Using the macro in post # 8, can it be modified to achieve the results below?

Data Range

	A​	B​	C​
1​	First​	Second​	Count​
2​	1A​	CC​	1​
3​	1A​	CC​	1​
4​	1A​	CC​	2​
5​	1A​	XX​	1​
6​	1A​	XX​	1​
7​	1A​	XX​	2​
8​	2A​	BB​	1​
9​	2A​	BB​	1​
10​	2A​	BB​	2​
11​	2A​	DD​	1​
12​	2A​	DD​	1​
13​	2A​	DD​	1​
14​	2A​	DD​	2​

Results

	D​	E​	F​	G​	H​
1​	​	​	1​	2​	Total​
2​	1A​	CC​	2​	1​	3​
3​	1A​	XX​	2​	1​	3​
4​	2A​	BB​	2​	1​	3​
5​	2A​	DD​	3​	1​	4​

 

[Fluff]

Like this

Sub MG26Dec46()
Dim Rng         As Range
Dim Dn          As Range
Dim Twn         As String
Dim Q
Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    With CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
        For Each Dn In Rng
            Twn = Dn & Dn.Offset(, 1)
                If Not .Exists(Twn) Then
                  If Dn.Offset(, 2) = 1 Then
                    .Add Twn, Array(Dn, Dn.Offset(, 1), 1, 0, 1)
                  Else
                     .Add Twn, Array(Dn, Dn.Offset(, 1), 0, 1, 1)
                  End If
                Else
                    Q = .Item(Twn)
                    Q(Dn.Offset(, 2) + 1) = Q(Dn.Offset(, 2) + 1) + 1
                    Q(4) = Q(4) + 1
                    .Item(Twn) = Q
                End If
        Next
Range("E2").Resize(.Count, 5) = Application.Transpose(Application.Transpose(.Items))
End With
End Sub

 

[jeffreybrown]

Thanks Fluff, this is perfect. Now if only I can understand it.