VBA Excel - Userform with comboboxes filter down and write - excel

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