MEMBUAT LIST SEARCHING DATA DINAMIS

Bismillahi Rahmani Rahim

Assalamualaikum Wr. Wb.

Akhirnya bisa nulis lagi, kali ini pembahasan artikelnya mungkin sedikit jarang digunakan dan memang masih jarang penggunaan model ini.

Membuat "List Searching Data Dinamis" biasanya digunakan pada formulir input data untuk meminimalisir kesalahan input keyData seperti nama, Lokasi dan sebagainya, seperti contoh animasi aplikasi saya dibawah ini.

Pencarian nama driver dengan cara mengetikkan huruf yang terkandung dalam nama personal tersebut akan menampilkan driver tersebut pada list teratas. Jika nama telah berada di list teratas maka kita hanya menekan enter dan nama personal tersebut otomatis masuk ke textbox hasil pencarian.

Ok kita langsung saja ke TKP.

Alat dan Bahan :

- 1 File Berekstensi Macro Enabled

- 1 Userform, 1 Textbox, 1 Listbox

- 1 Image dan secukupnya Label

Assembly:

1. Buat 1 File berekstensi macro enabled xlsm atau xlsb  dan rename salah satu sheet menjadi nama sheet "Sampel Data" dan isikan data seperti gambar dibawah ini. 
   
2. Masuk ke jendela VBA (tekan Alt F11) kemudian insert Userform
3. Klik Userform dan insert semua properti yang dingginkan seperti Textbox, Listbox, Image, Label dan atur sesuai keinginan tetapi ingat untuk mengganti nama masing-masing properti sesuai coding script dibawah ini :
4. Userform = formPencarian, Textbox = txtCari, Listbox = lBoxPencarian, Label = lblNotif dan lblNotifENter, Image1
5. Setelah mengganti semua nama property mari kita mulai mengatur posisi property agar lebih user friendly hahaha...... pakai bahasa istilah dikit boleh donk, lihat gambar berikut ini 
     

Sekarang mari kita double klik pada textbox (txtCari) kemudian masukkan script berikut :

Private Sub txtCari_AfterUpdate()

      On Error Resume Next

      Me.txtCari.Value = Me.lBoxPencarian.List(0, 0)

      Me.lBoxPencarian.Visible = False

      Me.lblNotifENter.Visible = False

End Sub

Private Sub txtCari_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

    On Error Resume Next

    Me.txtCari.Value = Me.lBoxPencarian.List(0, 0)

    Me.lBoxPencarian.Visible = False

    Me.lblNotifENter.Visible = False

End Sub

Private Sub txtCari_Change()

    Me.lblNotifENter.Visible = True

    If Me.txtCari.Value = "" Then

        Me.lBoxPencarian.Visible = False

        Exit Sub

    End If

    

    Me.lBoxPencarian.Visible = True

    Dim shtPencarian    As Worksheet

    Dim BarisMulai      As Long

    Dim PosisiKolom     As Integer

    Dim TeksPencarian   As String

    Dim Hasil           As String

    Dim RngCell         As Range

    Dim rngCariUlang    As Range

                

            '============================== KODE KHUSUS LITSBOX =================================

            TeksPencarian = UCase(Me.txtCari.Value)                 'Teks yang dicari

            PosisiKolom = 2                                         'Kolom Kriteria Pencarian di Tabel Sheet

            BarisMulai = 4                                          'Pencarian dimulai di baris

            Set shtPencarian = ThisWorkbook.Sheets("Sampel Data")   'Setting Sheet Destinasi

            '====================================================================================

            

    Me.lBoxPencarian.Clear

        If Trim(TeksPencarian) <> "" Then

        Do Until shtPencarian.Cells(BarisMulai, PosisiKolom) = ""

            With shtPencarian.Range(shtPencarian.Cells(BarisMulai, PosisiKolom), shtPencarian.Cells(500, PosisiKolom))

            Set rngCariUlang = shtPencarian.Range(shtPencarian.Cells(BarisMulai, PosisiKolom), _

            shtPencarian.Cells(500, PosisiKolom))

                    Set Rng = .Find(What:=TeksPencarian, After:=.Cells(1), LookIn:=xlFormulas, _

                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

                    If Not Rng Is Nothing Then

                        Me.lBoxPencarian.AddItem Rng

                        On Error Resume Next

                        Hasil = Application.WorksheetFunction.Match(Me.lBoxPencarian.List(Me.lBoxPencarian.ListIndex + 1, 0), _

                        rngCariUlang, 0)

                    End If

            End With

        On Error GoTo Berhenti

        BarisMulai = Hasil + BarisMulai + 1

        Loop

        End If

Berhenti:

End Sub

Private Sub txtCari_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Me.lblNotif.Visible = True

End Sub

Untuk Listbox (lBoxPencarian) double klik dan masukkan script ini:

Private Sub lBoxPencarian_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    Me.txtCari = Me.lBoxPencarian.List(0, 0)

    Me.lblNotifENter.Visible = False

End Sub

Untuk Userform DoubleClick dan masukkan ini

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

      Me.lblNotif.Visible = False

End Sub

Untuk Image1 DoubleClick dan masukkan script ini: 

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Me.lblNotif.Visible = False

End Sub

Jangan lupa insert sebuah modul untuk script macro pemanggilan di sheet

di jendela VBA klik Insert >> Module kemudian masukkan script berikut

Sub tampilkancari()

    formPencarian.Show

End Sub

Kemudian di WorkSheet "Sampel Data" insert Shapes kotak saja kemudian klik kanan >> assign Macro... kemudian Pilih "tampilkancari"

SAVE hasil kerja anda :) ingat format xlsm atau xlsb

Hasil dari percobaan kita seperti animasi berikut

Untuk Contoh file dapat di lihat dengan klik link  kemudian cari judul file "List Seraching Data Dinamis". atau klik pada menu blog kemudian pilih Download >> File >> Aplikasi VBA.

Sekian artikel kali ini, jangan bosan untuk berkunjung semoga saran anda menghasilkan inspirasi baru :)

Wassalam

KJ99

EIUG Makassar

Read More