Snasui Excel Forum

Code: Select all

Private Sub ComboBox1_Change()

ComboBox2.Clear
ComboBox3.Clear

Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To LastRow
    y = Application.WorksheetFunction.CountIfs(Range(Cells(2, 3), Cells(i, 3)), Cells(i, 3), Range(Cells(2, 2), Cells(i, 2)), ComboBox1)
    z = Application.WorksheetFunction.CountIfs(Range(Cells(2, 4), Cells(i, 4)), Cells(i, 4), Range(Cells(2, 2), Cells(i, 2)), ComboBox1)

If Cells(i, 2) = ComboBox1 Then
    If y = 1 Then ComboBox2.AddItem Cells(i, 3)
    If z = 1 Then ComboBox3.AddItem Cells(i, 4)
End If

Next i

End Sub

Private Sub ComboBox2_Change()

ComboBox1.Clear
ComboBox3.Clear

Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To LastRow
    x = Application.WorksheetFunction.CountIfs(Range(Cells(2, 2), Cells(i, 2)), Cells(i, 2), Range(Cells(2, 3), Cells(i, 3)), ComboBox2)
    z = Application.WorksheetFunction.CountIfs(Range(Cells(2, 4), Cells(i, 4)), Cells(i, 4), Range(Cells(2, 3), Cells(i, 3)), ComboBox2)

If Cells(i, 3) = ComboBox2 Then
    If x = 1 Then ComboBox1.AddItem Cells(i, 2)
    If z = 1 Then ComboBox3.AddItem Cells(i, 4)
End If

Next i

End Sub

Private Sub ComboBox3_Change()

ComboBox1.Clear
ComboBox2.Clear

Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To LastRow
    x = Application.WorksheetFunction.CountIfs(Range(Cells(2, 2), Cells(i, 2)), Cells(i, 2), Range(Cells(2, 4), Cells(i, 4)), ComboBox3)
    y = Application.WorksheetFunction.CountIfs(Range(Cells(2, 3), Cells(i, 3)), Cells(i, 3), Range(Cells(2, 4), Cells(i, 4)), ComboBox3)

If Cells(i, 4) = ComboBox3 Then
    If x = 1 Then ComboBox1.AddItem Cells(i, 2)
    If y = 1 Then ComboBox2.AddItem Cells(i, 3)
End If

Next i
End Sub

Private Sub UserForm_Initialize()

Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

Dim x As Integer, y As Integer, z As Integer

For i = 2 To LastRow
    x = Application.WorksheetFunction.CountIf(Range(Cells(2, 2), Cells(i, 2)), Cells(i, 2))
    y = Application.WorksheetFunction.CountIf(Range(Cells(2, 3), Cells(i, 3)), Cells(i, 3))
    z = Application.WorksheetFunction.CountIf(Range(Cells(2, 4), Cells(i, 4)), Cells(i, 4))
    
    If x = 1 Then ComboBox1.AddItem Cells(i, 2)
    If y = 1 Then ComboBox2.AddItem Cells(i, 3)
    If z = 1 Then ComboBox3.AddItem Cells(i, 4)
Next i
    
End Sub

Code: Select all

Dim sList As Object
Dim cLsList As Object
Dim cnList As Object
Dim r As Range, rall As Range

Private Sub ComboBox1_Change()
    Set cLsList = CreateObject("Scripting.Dictionary")
    ComboBox2.Clear
    With Sheets("Sheet1")
        For Each r In rall.Offset(0, 1)
            If r.Offset(0, -1).Value = Me.ComboBox1.Value _
                And Not cLsList.Exists(r.Value) Then
                cLsList.Add Key:=r.Value, Item:=r.Value
                Me.ComboBox2.AddItem r.Value
            End If
        Next r
    End With
End Sub

Private Sub ComboBox2_Change()
    Set cnList = CreateObject("Scripting.Dictionary")
    ComboBox3.Clear
    With Sheets("Sheet1")
        For Each r In rall.Offset(0, 2)
            If r.Offset(0, -2).Value = Me.ComboBox1.Value _
                And r.Offset(0, -1).Value = Me.ComboBox2.Value _
                And Not cnList.Exists(r.Value) Then
                cnList.Add Key:=r.Value, Item:=r.Value
                Me.ComboBox3.AddItem r.Value
            End If
        Next r
    End With
End Sub

Private Sub UserForm_Initialize()
    Set sList = CreateObject("Scripting.Dictionary")
    With Sheets("Sheet1")
        Set rall = .Range("b2", .Range("b" & .Rows.Count).End(xlUp))
        For Each r In rall
            If Not sList.Exists(r.Value) Then
                sList.Add Key:=r.Value, Item:=r.Value
                Me.ComboBox1.AddItem r.Value
            End If
        Next r
    End With
End Sub

Code: Select all

Dim sList As Object
Dim cLsList As Object
Dim cnList As Object
Dim r As Range, rall As Range

Private Sub ComboBox1_Change()
    Set cLsList = CreateObject("Scripting.Dictionary")

    With Sheets("Sheet1")
    
    If ComboBox2 = "" Then
        ComboBox2.Clear
        For Each r In rall.Offset(0, 1)
            If r.Offset(0, -1).Value = Me.ComboBox1.Value _
                And Not cLsList.Exists(r.Value) Then
                cLsList.Add Key:=r.Value, Item:=r.Value
                Me.ComboBox2.AddItem r.Value
            End If
    ComboBox1.Enabled = False
        Next r
    End If
    
      If ComboBox3 = "" Then
        ComboBox3.Clear
        For Each r In rall.Offset(0, 2)
            If r.Offset(0, -2).Value = Me.ComboBox1.Value _
                And Not cLsList.Exists(r.Value) Then
                cLsList.Add Key:=r.Value, Item:=r.Value
                Me.ComboBox3.AddItem r.Value
            End If
                ComboBox1.Enabled = False
        Next r
          End If
          
    End With
    
End Sub

Private Sub ComboBox2_Change()
    Set cnList = CreateObject("Scripting.Dictionary")

    With Sheets("Sheet1")

        If ComboBox1 = "" Then
        ComboBox1.Clear
        For Each r In rall.Offset(0, 0)
            If r.Offset(0, 1).Value = Me.ComboBox2.Value _
                And Not cLsList.Exists(r.Value) Then
                cLsList.Add Key:=r.Value, Item:=r.Value
                Me.ComboBox1.AddItem r.Value
            End If
    ComboBox2.Enabled = False
        Next r
    End If
    
      If ComboBox3 = "" Then
        ComboBox3.Clear
        For Each r In rall.Offset(0, 2)
            If r.Offset(0, -1).Value = Me.ComboBox2.Value _
                And Not cLsList.Exists(r.Value) Then
                cLsList.Add Key:=r.Value, Item:=r.Value
                Me.ComboBox3.AddItem r.Value
            End If
                ComboBox2.Enabled = False
        Next r
          End If
          
    End With
End Sub

Private Sub ComboBox3_Change()
    Set cnList = CreateObject("Scripting.Dictionary")

    With Sheets("Sheet1")

        If ComboBox1 = "" Then
        ComboBox1.Clear
        For Each r In rall.Offset(0, 0)
            If r.Offset(0, 2).Value = Me.ComboBox3.Value _
                And Not cLsList.Exists(r.Value) Then
                cLsList.Add Key:=r.Value, Item:=r.Value
                Me.ComboBox1.AddItem r.Value
            End If
    ComboBox3.Enabled = False
        Next r
    End If
    
      If ComboBox2 = "" Then
        ComboBox2.Clear
        For Each r In rall.Offset(0, 1)
            If r.Offset(0, 1).Value = Me.ComboBox3.Value _
                And Not cLsList.Exists(r.Value) Then
                cLsList.Add Key:=r.Value, Item:=r.Value
                Me.ComboBox2.AddItem r.Value
            End If
                ComboBox3.Enabled = False
        Next r
          End If
          
    End With
    
End Sub

Private Sub UserForm_Initialize()
    Set sList = CreateObject("Scripting.Dictionary")
    With Sheets("Sheet1")
    
        Set rall = .Range("b2", .Range("b" & .Rows.Count).End(xlUp))
        For Each r In rall
            If Not sList.Exists(r.Value) Then
                sList.Add Key:=r.Value, Item:=r.Value
                Me.ComboBox1.AddItem r.Value
            End If
        Next r
        
        Set rbll = .Range("c2", .Range("c" & .Rows.Count).End(xlUp))
        For Each r In rbll
            If Not sList.Exists(r.Value) Then
                sList.Add Key:=r.Value, Item:=r.Value
                Me.ComboBox2.AddItem r.Value
            End If
        Next r
        
          Set rcll = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
          For Each r In rcll
            If Not sList.Exists(r.Value) Then
                sList.Add Key:=r.Value, Item:=r.Value
                Me.ComboBox3.AddItem r.Value
            End If
        Next r
        
    End With
End Sub