how to find the consecutive duplicates in excel

[sriniwaas]

in excel one column contains like below
1
2
5
6
1
2
5
6
3
4
Now i want to find out consecutive 1 2 coming 2 times. 5,6 coming 2 times. 3,4 coming 1 time. Please let me know how this can be achieve.
-----------------------------------------------------------------------------------------------------------------------------------
similarly consecutive 3 duplicates.
1
2
3
7
8
9
1
2
3
7
8
9
3
4
5

Now i want to find out consecutive 1 2 3 coming 2 times. 5,6 coming 2 times. 3,4 coming 1 time. Please let me know how this can be achieve.

 

[MickG]

Place your data in column "A" and your Requirement as shown in column "B & C".

Running the code will result in the data in column "D".

	A	B	C	D
1	1	123	2	2 Found
2	2	56	2	1 Found
3	3	34	1	1 Found
4	7
5	8
6	9
7	1
8	2
9	3
10	7
11	8
12	9
13	3
14	4
15	5
16	6

<tbody>
</tbody>

[COLOR=navy]Sub[/COLOR] MG08Oct24
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] nn [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Num [COLOR=navy]As[/COLOR] Variant, Sz [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Lst [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Dic [COLOR=navy]As[/COLOR] Object, K [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Set[/COLOR] Rng = Range("B1", Range("B" & Rows.Count).End(xlUp))
Lst = Range("A" & Rows.Count).End(xlUp).Row
[COLOR=navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
  [COLOR=navy]For[/COLOR] n = 1 To Lst [COLOR=navy]Step[/COLOR] Len(Dn.Value)
    Num = ""
    [COLOR=navy]For[/COLOR] nn = 0 To Len(Dn.Value) - 1
            Num = Num & Range("A" & n).Offset(nn).Value
        [COLOR=navy]Next[/COLOR] nn
        [COLOR=navy]If[/COLOR] Not Dic.Exists(Num) And Len(Num) = Len(Dn.Value) [COLOR=navy]Then[/COLOR]
           Dic.Add Num, 1
        [COLOR=navy]Else[/COLOR]
            Dic(Num) = Dic(Num) + 1
        [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] n
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] Dic.keys
            If Val(K) = Dn.Value Then 
                Dn.Offset(, 2).Value = Dic(K) & " Found"
                [COLOR=navy]Exit[/COLOR] For
            [COLOR=navy]End[/COLOR] If
        [COLOR=navy]Next[/COLOR] K
        Dic.RemoveAll
    [COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[Zubair Muhammad]

Hi,

This code will color consecutive duplicate cells

Sub ColorConsecutiveMacthes()
Dim myrange As Range, cell As Range, match1 As Range, match2 As Range
Set myrange = Range("A1:A16") 'Set your range here
myrange.Interior.ColorIndex = -4142
For I = 1 To myrange.Cells.Count - 1
Set match1 = Range(Cells(I, 1), Cells(I + 1, 1))
    For j = 1 To myrange.Cells.Count - (I + 1)
        Set match2 = Range(Cells(I + j + 1, 1), Cells(I + j + 2, 1))
    
        If match1.Cells(1, 1) = match2.Cells(1, 1) And match1.Cells(2, 1) = match2.Cells(2, 1) Then
        
       
            If match1.Cells(1, 1).Interior.ColorIndex = -4142 And match1.Cells(2, 1).Interior.ColorIndex = -4142 Then
             'Debug.Print match1.Address & "!" & match2.Address
                match1.Interior.ColorIndex = WorksheetFunction.RandBetween(5, 50)
                match2.Interior.ColorIndex = match1.Cells(1, 1).Interior.ColorIndex
            End If
        End If
    Next j

Next I
End Sub

 

[Aladin Akyurek]

Are you just wanting a count or a list with associated counts?