Menghapus nilai ganda dengan excel macro

Ketika anda mengentri data dalam database Excel dan entri data terdapat banyak data (baris) maka kemungkinan terjadinya data ganda atau nilai ganda pasti ada apalagi kalau entri datanya manual tanpa bantuan form , kecuali Anda membatasi atau Menolak data ganda dengan VBA pada saat pengentrian data.

Akan tetapi jika sudah terlanjur mengentry data dalam jumlah banyak sedangkan Anda hanya menginginkan 1 (satu) nilai atau data yang unik (tidak ada nilai ganda), maka apakah harus mencarinya satu-persatu ??? Saya yakin pasti membutuhkan tingkat kejelian yang sangat tinggi. Solusi yang paling tepat untuk kasus seperti di atas adalah menggunakan VBA. Dengan menggunakan kode VBA, pekerjaan yang membutuhkan waktu, kejelian, serta kesabaran tersebut, dapat dilakukan dengan sekejap mata.

Sebagai contoh, lihat ilustrasi berikut ini :

Menghapus nilai ganda dengan excel macro

Dari database diatas terlihat ada beberapa data ganda pada baris yang berbeda, kemudian dengan modul dibawah ini data ganda diatas lenyap sudah, silahkan copy paste kode macro dibawah ini

Sub HapusdataGandaSatuBarisPenuh()
Dim Z As Long
Dim iPaKolom As Long
iPaKolom = Range("B1000").End(xlUp).Row
For Z = iPaKolom To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("B1:B" & Z), Range("B" & Z).Text) > 1 Then
Range("B" & Z).EntireRow.Delete
End If
Next Z
End Sub

Modul atau kode macro diatas akan menghapus baris yang terdapat nilai ganda, misalnya nilai ganda ada pada kolom B baris ke 2, maka kode macro tersebut akan mengapus baris ke 2 pada kolom A kolom B kolom C kolom D dan seterusnya. Jika anda menginginkan yang dihapus hanya satu kolom saja, alias hanya kolom B2 tanpa menghapus kolom A2 kolom C2 kolom D2 dan seterusnya, makan gunakan kode macro dibawah ini

Sub HapusdataGandaSatuKolomSaja()
Dim Z As Long
Dim iPaKolom As Long
iPaKolom = Range("B1000").End(xlUp).Row
For Z = iPaKolom To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("B1:B" & Z), Range("B" & Z).Text) > 1 Then
Range("B" & Z).Delete Shift:=xlUp
End If
Next Z
End Sub