BELAJAR VBA EXCEL - CARA MEMBERIKAN HIGHLIGHT ISI CELL YANG DOUBLE

Kali ini Blog Belajar VBA Macro Excel  akan mengupas bagaimana input data menggunakan script vba macro untuk memberikan highlight atau pewarnaan cell. Dalam Session ini kita akan mengupas bagaimana memberikan warna pada kondisi tertentu? dan tentunya menggunakan fungsi / function yang kita buat sendiri.

PERMASALAHAN 

Contohnya kita memiliki data NIP sebegai berikut, dengan melihat data seperti itu terlintas difikiran bagaimana caranya untuk membuat validasi data, validasinya yaitu memberikan warna background merah pada data nik yang double?

 

SOLUSI

Mari saja kita mulai membuat suatu fungsi buatan kita sendiri

1. Pertama tama Klik Develover kemudian lanjutkan seperti dalam keterangan  gambar dibawah ini:
   
   
   Keterangan
   - Pastikan Tab ada pada tab developer, selanjutnya Klik (no.2) atau Klik (no.3)
   - Atau tekan Alt-F11 secara bersamaan


2. Setelah melakukan langkah 1 maka akan keluar Tampilan seperti dibawah ini :
   
   
   Keterangan
   - Klik yang ditunjuk No 1 pada gambar
   - Pilih persis sama dengan gambar yang ditunjuk No 2 pada gambar
   - Pilih persis sama dengan gambar yang ditunjuk No 3 pada gambar
   - Maka akan keluar bagian script persis sama dengan gambar yang ditunjuk No 5
   - Ketikan script tersebut pada bagian yang ditunjuk no.4
   


3. Selanjutnya Ketikan seperti dibawah ini pada bagian antara Private Sub Worksheet_Change(ByVal Target As Range) dengan End Sub  :
   
   

Option Explicit
Const LngKolomCari = 2

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lngRowDummy As Long
    Dim lngLoop As Long
    Dim bolFind As Boolean
    If Target.Column = 2 And Target.Row >= 3 Then
        lngLoop = 3
        Do While True
            If Sheet1.Cells(lngLoop, LngKolomCari) = 0 Then Exit Do
            If lngLoop <> Target.Row And Sheet1.Cells(lngLoop, LngKolomCari) = Sheet1.Cells(Target.Row, LngKolomCari) Then
                Sheet1.Range(Sheet1.Cells(lngLoop, LngKolomCari).Address).Interior.ColorIndex = 3
                Sheet1.Range(Sheet1.Cells(Target.Row, LngKolomCari).Address).Interior.ColorIndex = 3
                Exit Do
            Else
                Sheet1.Range(Sheet1.Cells(Target.Row, LngKolomCari).Address).Interior.ColorIndex = 0
            End If
            lngLoop = lngLoop + 1
        Loop
        lngLoop = 3
        
        Do While True
            If Sheet1.Cells(lngLoop, LngKolomCari) = 0 Then Exit Sub
            If Sheet1.Range(Sheet1.Cells(lngLoop, LngKolomCari).Address).Interior.ColorIndex = 3 Then
                lngRowDummy = 3
                bolFind = False
                Do While True
                    If Sheet1.Cells(lngRowDummy, LngKolomCari) = 0 Then Exit Do
                    If lngLoop <> lngRowDummy And Sheet1.Cells(lngLoop, LngKolomCari) = Sheet1.Cells(lngRowDummy, 2) Then
                        Sheet1.Range(Sheet1.Cells(lngLoop, LngKolomCari).Address).Interior.ColorIndex = 3
                        Sheet1.Range(Sheet1.Cells(lngRowDummy, LngKolomCari).Address).Interior.ColorIndex = 3
                        bolFind = True
                        Exit Do
                    End If
                    lngRowDummy = lngRowDummy + 1
                Loop
                If bolFind = False Then
                    Sheet1.Range(Sheet1.Cells(lngLoop, 2).Address).Interior.ColorIndex = 0
                End If
            End If
            lngLoop = lngLoop + 1
        Loop
    End If
End Sub



4. Atau Koding yang lebih sederhana seperti ini  :
   
   

'Option Explicit
Const LngKolomCari = 2

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MaxBaris As Long, CArea As Range

    MaxBaris = Cells(Rows.Count, 2).End(xlUp).Row
    MaxBaris = WorksheetFunction.Max(MaxBaris, 3)
    
    Set CArea = Range("B3:B" & MaxBaris)
    If Intersect(Target, CArea) Then
        For Each sel In CArea
        cnt = WorksheetFunction.CountIf(CArea, sel)
        sel.Interior.ColorIndex = IIf(cnt > 1, 3, 0)
        Next sel
    End If 
End Sub



5. Selanjutnya Simpan file dengan extensi xlsb :
   
   
   
   
   


Selanjutnya Pemrograman macro sudah selesai dibuat silahkan coba, 

Keterangan
- Pada gambar background cell yang berwarna merah adalah menandakan bahwa NIK tersebut double

>>>>Source Alternatif ke 1 dapat disedot disini<<<<<

>>>>Source Alternatif ke 2 dapat disedot disini<<<<<