'For More : msexcelvba.com

Option Compare Text
Dim tablo2(), tablo3(), Category(), Supplier(), Product(), Price(), SD As Object, bul As String, c As Variant, i As Long



Private Sub ListBox1_Click()
On Error Resume Next
If ListBox1.ListIndex = -1 And IsError(Application.Match(ListBox1, Supplier, 0)) Then
        Set SD = CreateObject("Scripting.Dictionary")
        bul = ListBox1 & "*"
        For Each c In Supplier:
            If c Like bul Then SD(c) = ""
        Next c
        ListBox1.List = SD.keys
       
         Else
        Evn = ListBox1
        If Evn = "" Then Exit Sub
        Set d2 = CreateObject("Scripting.Dictionary")
        For i = LBound(Category) To UBound(Category)
            If Supplier(i) = Evn Then d2(Category(i)) = ""
        Next i
        tablo2 = d2.keys
        ListBox2.Clear
        ListBox3.Clear
        TextBox1 = ""
        ListBox2.List = tablo2
        ListBox2.SetFocus
        If Val(Application.Version) > 10 Then SendKeys "{f4}"
        End If
    i = Empty
    Set d2 = Nothing
End Sub

Private Sub ListBox2_Click()
If ListBox1 <> "" Then
        If ListBox2.ListIndex = -1 And IsError(Application.Match(ListBox2, Category, 0)) Then
            Set SD = CreateObject("Scripting.Dictionary")
            bul = UCase(ListBox) & "*"
            For Each c In tablo2
                If UCase(c) Like bul Then SD(c) = ""
            Next c
            ListBox2.List = SD.keys
             Else
            Set d3 = CreateObject("Scripting.Dictionary")
            If ListBox1 = "" Or ListBox2 = "" Then Exit Sub
                For i = LBound(Product) To UBound(Product)
                If Supplier(i) = ListBox1 And Category(i) = ListBox2 Then
                d3(Product(i)) = ""
                End If
            Next i
            tablo3 = d3.keys
            ListBox3.Clear
            ListBox3.List = tablo3
            ListBox3.SetFocus
            If Val(Application.Version) > 10 Then SendKeys "{f4}"
        End If
        End If
     i = Empty
     Set d3 = Nothing
End Sub

Private Sub ListBox3_Click()
 If ListBox1 <> "" And ListBox2 <> "" And ListBox3 <> "" Then
        If ListBox3.ListIndex = -1 And IsError(Application.Match(ListBox3, Product, 0)) Then
            Set SD = CreateObject("Scripting.Dictionary")
            bul = UCase(ListBox3) & "*"
            For Each c In tablo3
                If c Like bul Then SD(c) = ""
            Next c
            ListBox3.List = SD.keys
             Else
            For i = LBound(Product) To UBound(Product)
                If Supplier(i) = ListBox1 And Category(i) = ListBox2 And Product(i) = ListBox3 Then
                   TextBox1.Value = Price(i)
                              
                End If
            Next i
         End If
         End If
     i = Empty
End Sub

Private Sub UserForm_Initialize()
Dim k As Byte, x As Variant, LastRow As Long
Me.BackColor = 15658720
Me.Left = Application.Width - Me.Width - 30
Me.Top = 10
For k = 1 To 4
Controls("Frame" & k).BackColor = 15654720
Next
On Error Resume Next
LastRow = Sheets("Database").Range("A" & Sheets("Database").rows.Count).End(xlUp).Row
With Sheets("Database").Range("A2:A" & LastRow)
    If WorksheetFunction.CountBlank(.Cells) > 0 Then
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End If
End With

 Supplier = Application.Transpose(Range("Supplier"))
 Category = Application.Transpose(Range("Category"))
 Product = Application.Transpose(Range("Product"))
 Price = Application.Transpose(Range("Price"))
 Set SD = CreateObject("Scripting.Dictionary")
  For Each x In Supplier
      SD(x) = ""
 Next x
  
   ListBox1.List = SD.keys
 End Sub