Menampilkan Data Duplikat

Dengan menggunakan VBA ada beberapa metode atau cara yang digunakan untuk mengambil data duplikat pada data tertentu dan menampilkannya pada sheet atau Range Lain

Misalnya disini ada sebuah data yang memiliki duplikat seperti pada kolom B dibawah ini. dan hasilnya ingin seperti pada kolom E.

Ada beberapa metode logika yang digunakan untuk mencapai hasil seperti diatas, diantaranya :

1. Metode Countif

Sub AmbilDuplikat1()
Dim Rng As Range, Sel As Range
Dim Baris As Long
Set WF = WorksheetFunction

With Sheet1
    Set Rng = .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
    Baris = 3
    For Each Sel In Rng
        If WF.CountIf(Rng, Sel) > 1 Then
            If WF.CountIf(Columns(5), Sel) = 0 Then
                Cells(Baris, 5) = Sel
                Baris = Baris + 1
            End If
        End If
    Next Sel
End With

End Sub

2. Metode Countif Dengan Array

Sub AmbilDuplikat2()
Dim Sel As Variant
Dim TmpData As Variant
Dim x As Long, y As Long
Set WF = WorksheetFunction

ReDim TmpData(x)
With Sheet1
    With .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
        For Each Sel In .Value
            If WF.CountIf(.Cells, Sel) > 1 Then
                For y = 0 To UBound(TmpData)
                    If TmpData(y) = Sel Then Exit For
                Next
                If y = UBound(TmpData) + 1 Then
                    ReDim Preserve TmpData(x)
                    TmpData(x) = Sel
                    x = x + 1
                End If

            End If
        Next
    End With


    .Range("E3").Resize(UBound(TmpData) + 1).Value = Application.Transpose(TmpData)
End With
End Sub

Metode ArrayList

Sub AmbilDuplikat3()
Dim LData As Object, LDups As Object
Dim Rng As Range, Sel As Range

Set LData = CreateObject("System.Collections.ArrayList")
Set LDups = CreateObject("System.Collections.ArrayList")

With Sheet1
    Set Rng = .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
    For Each Sel In Rng
        If LData.Contains(Sel.Value) Then
            If Not LDups.Contains(Sel.Value) Then
                LDups.Add Sel.Value
            End If
        End If
        LData.Add Sel.Value
    Next

    .Range("E3").Resize(LDups.Count).Value = Application.Transpose(LDups.ToArray)
End With
End Sub

Metode Dictionary

Sub AmbilDuplikat4()
Dim Dic As Object
Dim rng As Range, Sel As Range
Dim Baris As Long

Set Dic = CreateObject("Scripting.Dictionary")
Dic.comparemode = vbTextCompare

With Sheet1
    Set rng = .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
    Baris = 3
    
    For Each Sel In rng
        If Not Dic.exists(Sel.Value) Then
            Dic.Add Sel.Value, 0
        Else
            If Dic(Sel.Value) = 0 Then
                Dic(Sel.Value) = 1
                .Cells(Baris, "E").Value = Sel.Value
                Baris = Baris + 1
            End If
        End If
    Next Sel
End With
End Sub

Metode ADO

Sub AmbilDuplikat5()
Dim rs As Object, Rng As String

Set rs = CreateObject("ADODB.Recordset")
With Sheet1
    Rng = .Name & "$" & .Range("B2", .Cells(.Rows.Count, "B").End(xlUp)).Address(False, False)
End With

rs.Open "SELECT [Data User] FROM [" & Rng & "] GROUP BY [Data User] HAVING COUNT([Data User]) > 1", _
        "Provider=MSDASQL;DSN=Excel Files;DBQ=" & ThisWorkbook.FullName

If Not rs.EOF Then Range("E3").CopyFromRecordset rs
rs.Close
Set rs = Nothing
End Sub