Home > Blockchain >  Check Table if Filter exist VBA Excel
Check Table if Filter exist VBA Excel

Time:10-25

I am trying to change the backgroundcolor of Commandbuttons in a userform depending on the filter in a table.

How can i check the result of the autofilter exist or not and if the result is right. The CommandButton2 has the capion Dummy 4, the result of the table will be empty.

enter image description here

Private Sub UserForm_Initialize()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = ActiveSheet
Dim tbl As ListObject: Set tbl = ws.ListObjects("table1")

With tbl
    .Range.AutoFilter Field:=1, Criteria1:=ws.Range("E2")
    .Range.AutoFilter Field:=2, Criteria1:=ws.Range("F2")
    .Range.AutoFilter Field:=3, Criteria1:=ws.Range("G2")
End With

'if table is empty make the button red
CommandButton1.BackColor = RGB(0, 255, 0)


CommandButton2.BackColor = RGB(255, 0, 0)

End Sub

I already tried it with isempty() but couldnt get the right result.

Edit: Got this

Private Sub UserForm_Initialize()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = ActiveSheet
Dim tbl As ListObject: Set tbl = ws.ListObjects("table1")

With tbl
    .Range.AutoFilter Field:=1, Criteria1:=ws.Range("E2")
    .Range.AutoFilter Field:=2, Criteria1:=ws.Range("F2")
    .Range.AutoFilter Field:=3, Criteria1:=ws.Range("G2")
End With


On Error Resume Next
tbl.DataBodyRange.SpecialCells (xlCellTypeVisible)

If Err = 0 Then
CommandButton1.BackColor = RGB(0, 255, 0)
Else
CommandButton1.BackColor = RGB(255, 0, 0)
End If



End Sub

CodePudding user response:

Test Excel Table Filter Results

Option Explicit

Private Sub UserForm_Initialize()
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim tbl As ListObject: Set tbl = ws.ListObjects("Table1")
    
    Dim rg As Range
    
    With tbl
        .Range.AutoFilter Field:=1, Criteria1:=ws.Range("E2")
        .Range.AutoFilter Field:=2, Criteria1:=ws.Range("F2")
        .Range.AutoFilter Field:=3, Criteria1:=ws.Range("G2")
        On Error Resume Next
            Set rg = .DataBodyRange.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
    End With

    If rg Is Nothing Then
        CommandButton1.BackColor = RGB(0, 255, 0)
        CommandButton2.BackColor = RGB(255, 0, 0)
    Else
        CommandButton1.BackColor = RGB(255, 0, 0)
        CommandButton2.BackColor = RGB(0, 255, 0)
    End If

End Sub
  • Related