find duplicate range , position range

Hello,

For quick reply a short macro that looks in column A for the sequence a,b,c.
If this is the case all three cells will be made red.

Set up a sheet with in a same bogus values with sometime the sequence a, b and c in consecutieve rows. (row 4 = a, row 5 = b and row 6 = c)

This macro can be built out for your convenience with all parameters.

Sub test()
Dim c As Range
Dim lastrow As Long
Dim color As Long

lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

For Each c In Sheets(1).Range("A1:A" & lastrow).Cells
    If c.Value = "a" Then
        If c.Offset(1) = "b" And c.Offset(2) = "c" Then
            c.Resize(3).Interior.ColorIndex = 3
        End If
    End If
Next c

End Sub

Reg.
Demeter

thanks , Demeter
but i have to look for duplicate range that is a2:a25 , not just one cell .
also , in position sheet , if possible , name position of those duplicate ranges

When I do a quick check on duplicates in column "A" , I find there are no duplicates at all, If there are no duplicates in column "A" , then there are no duplicates in each Range of 25 cells, in column "A". so Am I looking for the right thing?????

Try this:-

Sub MG04Dec09
Dim Rng As Range, Dn As Range
Dim Lst As Long, n As Long, c As Long
Dim Frng As Range, Ac As Long, col As Long
Dim RStg As String, p As Long, K As Variant
Dim Q As Variant, Sp As Variant

Lst = Range("A" & Rows.Count).End(xlUp).Row
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For n = 2 To Lst Step 24
    For Ac = 1 To 24
        Set Frng = Range(Cells(n, Ac), Cells(n + 23, Ac))
        RStg = Join(Application.Transpose(Frng))
        If Not .Exists(RStg) Then
            .Add RStg, Array(Frng, Frng.Address)
        Else
            Q = .Item(RStg)
            Q(1) = Q(1) & "," & Frng.Address
            .Item(RStg) = Q
        End If
    Next Ac
Next n
c = 1
For Each K In .keys
    c = c + 1
    Sheets("Position").Cells(c, 1) = .Item(K)(0).Address
    Sp = Split(.Item(K)(1), ",")
        For p = 1 To UBound(Sp)
            Sheets("Position").Cells(c, p + 1) = Sp(p)
        Next p
Next K
MsgBox "Run"
End With
End Sub

Regards Mick

thank you sir , its working perfectly .....