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".

[TABLE="width: 212"]
<tbody>[TR]
[TD="class: xl63, width: 27"][/TD]
[TD="class: xl63, width: 64"]A
[/TD]
[TD="class: xl63, width: 64"]B
[/TD]
[TD="class: xl63, width: 64"]C
[/TD]
[TD="class: xl63, width: 64"]D
[/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]1
[/TD]
[TD="class: xl64"]1
[/TD]
[TD="class: xl65, align: right"]123
[/TD]
[TD="class: xl65, align: right"]2
[/TD]
[TD="class: xl65"]2 Found
[/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]2
[/TD]
[TD="class: xl66, bgcolor: white"]2
[/TD]
[TD="class: xl67, bgcolor: white, align: right"]56
[/TD]
[TD="class: xl67, bgcolor: white, align: right"]2
[/TD]
[TD="class: xl67, bgcolor: white"]1 Found
[/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]3
[/TD]
[TD="class: xl64"]3
[/TD]
[TD="class: xl65, align: right"]34
[/TD]
[TD="class: xl65, align: right"]1
[/TD]
[TD="class: xl65"]1 Found
[/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]4
[/TD]
[TD="class: xl68, bgcolor: white"]7
[/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]5
[/TD]
[TD="class: xl69"]8
[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]6
[/TD]
[TD="class: xl68, bgcolor: white"]9
[/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]7
[/TD]
[TD="class: xl64"]1
[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]8
[/TD]
[TD="class: xl66, bgcolor: white"]2
[/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]9
[/TD]
[TD="class: xl64"]3
[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]10
[/TD]
[TD="class: xl68, bgcolor: white"]7
[/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]11
[/TD]
[TD="class: xl69"]8
[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]12
[/TD]
[TD="class: xl68, bgcolor: white"]9
[/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]13
[/TD]
[TD="class: xl70"]3
[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]14
[/TD]
[TD="class: xl71, bgcolor: white"]4
[/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]15
[/TD]
[TD="class: xl70"]5
[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"][/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]16
[/TD]
[TD="class: xl71, bgcolor: white"]6
[/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[TD="class: xl67, bgcolor: white"][/TD]
[/TR]
</tbody>[/TABLE]

[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?