VBA Excel - Userform with comboboxes filter down a

Question

I'm looking for some advise on this code. It is a UserForm with 3 comboboxes the first one filters the BLOCK (unique values), the second one the TAG (also unique) and the last it will be the ACT. After selecting all 3 we write the STATUS on the same line.

The first filter is ok, but I dont know how to go further I couldnt get Autofilter to work on the second filter... Any better solution?

Below the code I have and the table.

Thanks,

Private Sub UserForm_Initialize()

    Dim v, e, lastrow
    lastrow = Sheets("Plan1").Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("Plan1").Range("A2:A" & lastrow)
        v = .Value
    End With
    With CreateObject("scripting.dictionary")
        .comparemode = 1
        For Each e In v
            If Not .exists(e) Then .Add e, Nothing
        Next
        If .Count Then Me.cbBloco.List = Application.Transpose(.keys)
    End With

End Sub

-

BLOCK        ACT    TAG          STATUS
M00          FAB    201-02-31
M00          MON    201-02-31
M02          FAB    201-02-32
M02          MON    201-02-32
M02          INS    201-02-32
M02          FAB    201-02-33
M02          MON    201-02-33
M02          INS    201-02-33
M02          TER    201-02-33

Answer 1

edited after op's detailed specs edited 2: after OP's new specs

try this in Form's Module

Option Explicit

Dim cnts(1 To 3) As ComboBox
Dim list(1 To 3) As Variant
Dim dataRng As Range, dbRng As Range, statusRng As Range, helperRng As Range


Private Sub UserForm_Initialize()

Set dbRng = Sheets("Plan1").UsedRange
Set helperRng = dbRng.Offset(dbRng.Rows.Count + 1, dbRng.Columns.Count + 1).Cells(1, 1)
Set dataRng = dbRng.Offset(1).Resize(dbRng.Rows.Count - 1)
Set statusRng = dataRng.Columns(dbRng.Columns.Count)

With Me
    Set cnts(1) = .cbBloco '<== give control its actual name
    Set cnts(2) = .cbAct '<== give control its actual name
    Set cnts(3) = .cbTag '<== give control its actual name
End With

Call FillComboBoxes

End Sub


Private Sub FillComboBoxes()
Dim i As Long

Application.ScreenUpdating = False

dbRng.Autofilter field:=4, Criteria1:="<>ISSUED" ' <== added, to avoid rows with "ISSUED" status

For i = 1 To UBound(cnts)

    dataRng.SpecialCells(xlCellTypeVisible).Columns(i).Copy Destination:=helperRng

    With helperRng.CurrentRegion
        If .Rows.Count > 1 Then .RemoveDuplicates Columns:=Array(1), Header:=xlNo
        With .CurrentRegion
            If .Rows.Count > 1 Then
                list(i) = Application.Transpose(.Cells)
            Else
                list(i) = Array(.Value)
            End If
            cnts(i).list = list(i)
            .Clear
        End With
    End With

Next i
Application.ScreenUpdating = True

End Sub


Private Sub ResetComboBoxes()
Dim i As Long

FillComboBoxes '<== added. since you don't want "ISSUED" rows to be shown, all lists must be refilled
'For i = 1 To UBound(cnts)
'    cnts(i).list = list(i)
'    cnts(i).ListIndex = -1
'Next i

End Sub


Private Sub CbOK_Click()
Dim i As Long

statusRng.ClearContents

With dbRng
    dbRng.Autofilter field:=4, Criteria1:="<>ISSUED" ' <== added, to avoid rows with "ISSUED" status
    For i = 1 To UBound(cnts)
        .Autofilter field:=i, Criteria1:=cnts(i).Value
    Next i

    If .SpecialCells(xlCellTypeVisible).Cells.Count > .Columns.Count Then
        statusRng.SpecialCells(xlCellTypeVisible).Value = "ISSUED"
    Else
        MsgBox "No Match"
    End If

    .Autofilter
    dbRng.Autofilter field:=4, Criteria1:="<>ISSUED" ' <== added, to avoid rows with "ISSUED" status
End With

End Sub


Private Sub CbReset_Click()
Call ResetComboBoxes
End Sub


Private Sub cbAct_AfterUpdate()
    Call UpdateComboBoxes
End Sub


Private Sub cbBloco_AfterUpdate()
    Call UpdateComboBoxes
End Sub


Private Sub cbTag_AfterUpdate()
    Call UpdateComboBoxes
End Sub


Private Sub UpdateComboBoxes()

Dim i As Long

With dbRng
    .Autofilter
    dbRng.Autofilter field:=4, Criteria1:="<>ISSUED" ' <== added, to avoid rows with "ISSUED" status
    For i = 1 To UBound(cnts)
        If cnts(i).ListIndex > -1 Or cnts(i).text <> "" Then .Autofilter field:=i, Criteria1:=cnts(i).Value
    Next i

    If .SpecialCells(xlCellTypeVisible).Cells.Count > .Columns.Count Then
        Call RefillComboBoxes
    Else
        Call ClearComboBoxes
    End If

    .Autofilter
    dbRng.Autofilter field:=4, Criteria1:="<>ISSUED" ' <== added, to avoid rows with "ISSUED" status
End With

End Sub


Private Sub RefillComboBoxes()
Dim i As Long, j As Long
Dim cell As Range

Application.ScreenUpdating = False
For i = 1 To UBound(cnts)

    j = 0
    For Each cell In dataRng.Columns(i).SpecialCells(xlCellTypeVisible)
        helperRng.Offset(j) = cell.Value
        j = j + 1
    Next cell

    With helperRng.CurrentRegion
        If .Rows.Count > 1 Then .RemoveDuplicates Columns:=Array(1), Header:=xlNo
        With .CurrentRegion
            If .Rows.Count > 1 Then
                cnts(i).list = Application.Transpose(.Cells)
            Else
                cnts(i).list = Array(.Value)
            End If
            .Clear
        End With
    End With
Next i
Application.ScreenUpdating = True

End Sub


Private Sub ClearComboBoxes()

Dim i As Long

For i = 1 To UBound(cnts)
    cnts(i).Clear
Next i

End Sub