VBA同时过滤多列

Question

Jim L from Ontario was a tremendous help in solving my first challenge. You can review that at this link : Previous Discussion

I thought it would be a simple matter to add filters for additional columns once the DATE FILTER QUESTION was solved. Nope.

I've tried adding additional filters within the same confines as the DATE filter ... I've tried adding the additional filters in the same sub but below the DATE filter ... even placing the additional filters in separate subs. Nothing is working.

The example workbook may be downloaded here : Download Workbook

The end users will have a need to filter on one or more columns at the same time. How can I work that in with the existing code in the workbook ?

I'm stumped !

Thanks.

Answer 1

Try adding the auto-filter across all the columns and then use each button to set the criteria for one column only. Here is an example for the fist 3 columns that you can expand to the others.

COL_FILTER is an integer parameter to the sub filterCol which is generic to all the columns you want to add a filter to (except the date which is a special case). Assign your "UNIT" filter button to the sub FilterB, "Call RCVD" button to sub FilterC etc. When you first press any button the filter drop downs appear across all columns but only 1 column will have criteria applied. Pressing further buttons will set criteria for those additional columns and retain the previous filters. Entering a blank search term will remove the criteria for that column only

Option Explicit

Sub ResetFilters()
    Dim Wks As Worksheet
    Set Wks = Sheets("Call Log File")
    With Wks
        On Error Resume Next
        If Wks.AutoFilterMode Then
            Wks.AutoFilterMode = False
        End If
    End With
End Sub

Sub FilterB()
    Call filterCol(2)
End Sub

Sub FilterC()
    Call filterCol(3)
End Sub

Sub filterCol(COL_FILTER As Integer)

    Dim wb As Workbook, ws As Worksheet
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Call Log File")

    ' set auto filter to all columns if not already on
    Dim rngFilter As Range
    Set rngFilter = ws.Range("A2:K2")
    If ws.AutoFilterMode = False Then
        rngFilter.AutoFilter
    End If
    'Debug.Print rngFilter.Address

    ' get filter criteria
    Dim sColname As String
    sColname = ws.Cells(2, COL_FILTER)
    Dim sPrompt As String, sUserInput As String, n As Integer
    sPrompt = "Enter " & sColname
    sUserInput = InputBox$(sPrompt)

    Dim criteria(2) As String
    criteria(1) = "*" & sUserInput & "*"

    ' apply filter to the select column
    If ws.AutoFilterMode = True Then
        rngFilter.AutoFilter COL_FILTER, "=" & criteria(1)
    End If

End Sub


Sub FilterDate()

    Const COL_FILTER As Integer = 1 ' A

    Dim wb As Workbook, ws As Worksheet
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Call Log File")

    ' set auto filter to all columns if not already on
    Dim rngFilter As Range
    Set rngFilter = ws.Range("A2:K2")
    If ws.AutoFilterMode = False Then
        rngFilter.AutoFilter
    End If
    'Debug.Print rngFilter.Address

    Dim sPrompt As String, sUserInput As String, n As Integer
    sPrompt = "Enter DATE" & vbCrLf & _
    "For YEAR ONLY: YY" & vbCrLf & _
    "For YEAR & MONTH: YYMM" & vbCrLf & _
    "For YEAR & MONTH & DAY: YYMMDD"

    sUserInput = InputBox$(sPrompt)
    n = Len(sUserInput)
    If n = 0 Then
      rngFilter.AutoFilter COL_FILTER ' clear filter
      Exit Sub
    ElseIf Not (n = 2 Or n = 4 Or n = 6) Then
      MsgBox sUserInput & " is not correct", vbExclamation, "Wrong Format"
      Exit Sub
    End If

    Dim mydate As Variant
    mydate = dateRange(sUserInput)
    'Debug.Print sUserInput, mydate(1), mydate(2)

    If ws.AutoFilterMode = True Then
       rngFilter.AutoFilter COL_FILTER, ">=" & mydate(1), 1, "<=" & mydate(2)
    End If

End Sub

Function dateRange(s As String)
   Dim s1 As String, s2 As String
   s1 = "000"
   s2 = "999"
   Select Case Len(s)
     Case 2
       s1 = "0101" & s1
       s2 = "1231" & s2
     Case 4
       s1 = "01" & s1
       s2 = "31" & s2
     Case 6
       ' nothing to add
     Case Else
       dateRange = ""
       Exit Function
   End Select
   Dim rng(2) As Long
   rng(1) = CLng(s + s1)
   rng(2) = CLng(s + s2)
   dateRange = rng
End Function

Answer 2

Fo the benefit of others ... this following macro will search for a term in Col B, after the table was filtered by Col A. Although this is not a "filtering approach" in Col B, it is very effective and does precisely what I was looking for.

Thank you to all for your assistance.

Sub FilterB()
Dim cl As Range, rng As Range
Dim sPrompt As String, sUserInput As String

Set rng = Range("B3:B100")

sPrompt = "Enter SEARCH TERM"
sUserInput = InputBox$(sPrompt)

For Each cl In rng.SpecialCells(xlCellTypeVisible)
    If cl.Value <> sUserInput Then
        cl.Rows.Hidden = True
    End If
Next cl

End Sub

And this can be duplicated as many times as required to further "filter down" additional columns.