How to find row numbers of duplicate data in a column?

[Sachin2k6]

Hi friends,
i have data column of 10000 rows in which some cells has duplicate data. how can i find the row numbers of all duplicate cells in vba.
i have done this with the help of loop but is there any other faster way to do so??

Example
Data Column1
GC1
GC0
GC2
GC3
GC1
GC3
GC1
and so on........

how to find row numbers of duplicate "GC1" ?

 

[bebo021999]

What will you do with those row numbers? write to a cell as string, or write to a range, or just store in an array?
BTW, could you share the current working code?

 

[Sachin2k6]

What will you do with those row numbers? write to a cell as string, or write to a range, or just store in an array?
BTW, could you share the current working code?

i need to store these row numbers in an array to use rest part of the program.

 

[bebo021999]

Dictionary may help:

Option Explicit
Sub test()
Dim Lr&, k&, cell As Range, key
Dim dic As Object
Set dic = CreateObject("Scripting.dictionary")
Lr = Cells(Rows.Count, "A").End(xlUp).Row ' Last row in column A
    For Each cell In Range("A2:A" & Lr) ' Loop thru column A from cell A2
        If Not dic.exists(cell.Value) Then
            k = k + 1
            dic.Add cell.Value, cell.Row 'store row number of unique data. "dic" (dictionary) store unique data from column A
        End If
    Next
    For Each key In dic.keys ' loop thru unique items of dic
        Debug.Print key, dic(key) ' print out unique items value (key) and row (dic(key)
    Next
End Sub

 

[Sachin2k6]

Dictionary may help:

Option Explicit
Sub test()
Dim Lr&, k&, cell As Range, key
Dim dic As Object
Set dic = CreateObject("Scripting.dictionary")
Lr = Cells(Rows.Count, "A").End(xlUp).Row ' Last row in column A
    For Each cell In Range("A2:A" & Lr) ' Loop thru column A from cell A2
        If Not dic.exists(cell.Value) Then
            k = k + 1
            dic.Add cell.Value, cell.Row 'store row number of unique data. "dic" (dictionary) store unique data from column A
        End If
    Next
    For Each key In dic.keys ' loop thru unique items of dic
        Debug.Print key, dic(key) ' print out unique items value (key) and row (dic(key)
    Next
End Sub

Through loop i have also done it but loop goes through all 10000 row , that i want to skip and need a faster way.

 

[bebo021999]

2nd Loop for debug.print would take time, just remove it. I put it for testing only.

 

[Tupe77]

This is still a loop, but are you sure it will take too long?
With my test data, it goes through 50,000 lines in 0.2 seconds.
Debug.print takes a lot of time, but it's just testing the operation.

What format should the finished data be in?
In my model, the value and rows are together because I didn’t invent a purpose for rows alone, without a connecting factor?

Possibly this could be done by Evaluating or filtering, but someone else can answer it.

Sub TS_NonUniqueValueRowsOMA()
Dim i As Long, j As Long, key As Variant, Startrow As Integer, Lastrow As Long, Tmp As String, ReadRNG As Range
Dim arr As Variant, arRow As Varian
Dim dict As Object: Set dict = CreateObject("Scripting.dictionary")
Lastrow = Cells(Rows.Count, 1).End(xlUp).Row ' Last row in column A
Dim coT As Single: coT = Timer()
Set ReadRNG = Range("A2:A" & Lastrow)
Startrow = ReadRNG.Cells(1).Row - 1 ' Starting row
arr = ReadRNG.Value

    For i = LBound(arr) To UBound(arr)
    Tmp = CStr(arr(i, 1))
        If dict.exists(Tmp) Then
            dict(Tmp) = dict(Tmp) & ";" & i + Startrow
        Else
            dict.Add (Tmp), i + Startrow
        End If
    Next i
    For Each key In dict.Keys ' loop thru unique items of dict
        If InStr(dict(key), ";") > 0 Then ' Test if it's dublicate
        
            'Debug.Print key, dict(key) ' print non unique items value (key) and rows (dict(key)
            'Debug.Print Split(dict(key), ";") 'print Only rows with dublicates
            arRow = Split(dict(key), ";")
            
            ' example to read dublicated rows
            If UBound(arRow) > 1 Then
                For j = LBound(arRow) To UBound(arRow)
                    'Debug.Print ReadRNG.Rows(arRow(j)).Address
                Next j
            End If
            ' example end
        End If
    Next
Debug.Print "Loop take " & Timer() - coT & " Seconds" ' Timer to count used time
End Sub