VBA UserForm - color change & filtering of rows in UserForm

[BluEEyE86]

Hi Team,

I have visible rows in "lstDatabase" (bottom window). Is there any method to filter them or change color of whole row according to column "Status" ? For example, status "Otwarte" for yellow color or status "Zwolnione" for green color. I'd like to add additional button called like "filter" & make filtering of this window accoroding to choosen "Status". I' tried to do this manualy in both ways in excel sheet "Database" but bottom window isn't refreshed.

My code:

Sub Reset()
   
    Dim iRow As Long
   
    iRow = [Counta(Database!A:A)] ' indentifying the last row
   
    With mapFORM
       
        .cmbType.Clear
        .cbRegister.Clear
        .cbApprover.Clear
        .ComboBox1.Clear
        .cbTSRname.Clear
           
        .txtRollNo.Value = ""
        .txtTSRnumber = ""
           
        .cmbStatus.AddItem "Otwarte"
        .cmbStatus.AddItem "Decyzja"
        .cmbStatus.AddItem "Retest"
        .cmbStatus.AddItem "Zwolnione"
        .cmbStatus.AddItem "Odrzucone"
        .cmbStatus.AddItem "Zamknięte"
       
        .Frame3.Visible = False
        .Frame4.Visible = False
        .SubmitButton.Visible = False
        .UpdateButton.Visible = False
           
        .lstDatabase.ColumnCount = 11
        .lstDatabase.ColumnHeads = True
       
        .lstDatabase.ColumnWidths = "60,60,80,60,60,120,300,60,60,120,60"
       
        If iRow > 1 Then
       
            .lstDatabase.RowSource = "Database!A2:K" & iRow
                   
        Else
       
            .lstDatabase.RowSource = "Database!A2:K2"
       
        End If
              
    End With
       
End Sub

 

[BluEEyE86]

Hi All,

I started to solve it by Filtering. I have add below codes:

Private Sub UserForm_Initialize()
        
    Call Reset
    mapFORM.txtRollNo.SetFocus
    
    mapFORM.Frame3.Visible = False
    mapFORM.Frame4.Visible = False
    mapFORM.SubmitButton.Visible = False
    mapFORM.UpdateButton.Visible = False
    
        Set ws1 = ThisWorkbook.Worksheets("Database")
        For x = 8 To 8
        mapFORM.Controls("cbFilter").Clear
        With CreateObject("Scripting.Dictionary")
        For Each rCell In ws1.Range(ws1.Cells(2, x), ws1.Cells(Rows.Count, x).End(xlUp))
        If Not .Exists(rCell.Value) And rCell.Value <> vbNullString Then .Add rCell.Value, Nothing
        Next rCell
        mapFORM.Controls("cbFilter").List = .keys
        .RemoveAll
        End With
        Next x
        Ary = ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp).Offset(, 10)).Value
        With mapFORM.lstDatabase
        .ColumnCount = 11
        .ColumnHeads = True
        .ColumnWidths = "60,60,80,60,60,120,300,60,60,120,60"
        End With
    
End Sub

Sub Filter()
   
    nr = 0
    ReDim Nary(1 To UBound(Ary), 1 To 11) As Variant
    For r = 1 To UBound(Ary)
    xstr = Join(Application.Index(Ary, r, 0), "")
    If InStr(1, xstr, ystr, vbTextCompare) Then
    nr = nr + 1
    For c = 1 To UBound(Ary, 2)
    Nary(nr, c) = Ary(r, c)
    Next c
    End If
    Next r
    
    mapFORM.lstDatabase.List = Nary
    
End Sub

Private Sub cbFilter_Change()

ystr = mapFORM.cbFilter.Value
Call Filter

When I'm starting to preocess this, "runtime error 70 - permission denied" appeared as below.

After debuging, below row is highlighted

As I already read, it happens when I'm trying to update already existing object. How can I do filtering when I want to use only one ListBox (lstDatabase) like in the first post. Is it possible ?

 

[BluEEyE86]

Hi Team,

I solved above problem with added second listbox which will refer to lstDatabase2 tab in excel sheet.

Can you please help me only with lstDatabase2 heads which becasue fields are empty.

lstDatabes heads (prior filtering)

lstDatabase2 (after filtering)

Here is a code for lstDatabase2:

Private Sub UserForm_Initialize()
               

               
    Call Reset
    mapFORM.txtRollNo.SetFocus
    
    mapFORM.Frame3.Visible = False
    mapFORM.Frame4.Visible = False
    mapFORM.SubmitButton.Visible = False
    mapFORM.UpdateButton.Visible = False
    mapFORM.lstDatabase2.Visible = False
    
        Set ws1 = ThisWorkbook.Worksheets("Database")
        For x = 8 To 8
        mapFORM.Controls("cbFilter").Clear
        With mapFORM 'CreateObject("Scripting.Dictionary")
        
            .cbFilter.AddItem "Bez filtra"
            .cbFilter.AddItem "Otwarte"
            .cbFilter.AddItem "Decyzja"
            .cbFilter.AddItem "Retest"
            .cbFilter.AddItem "Zwolnione"
            .cbFilter.AddItem "Odrzucone"
            .cbFilter.AddItem "Zamknięte"
        'For Each rCell In ws1.Range(ws1.Cells(2, x), ws1.Cells(Rows.Count, x).End(xlUp))
        'If Not .Exists(rCell.Value) And rCell.Value <> vbNullString Then .Add rCell.Value, Nothing
        'Next rCell
        'mapFORM.Controls("cbFilter").List = .keys
        '.RemoveAll
        End With
        Next x
        Ary = ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp).Offset(, 10)).Value
        
        With mapFORM.lstDatabase2
        .ColumnCount = 11
        .ColumnHeads = True
        .ColumnWidths = "60,60,80,60,60,120,300,60,60,120,60"

        End With
    
End Sub

Thank you for supprt.