What to do when autofilter in VBA returns no data?

后端 未结 5 1743
北恋
北恋 2020-12-19 08:51

I am trying to filter a range of values and based on my criteria, at times I might have no data that fits my criteria. In that case, I do not want to copy any data from the

相关标签:
5条回答
  • 2020-12-19 08:53

    You can put the code blow into a function.

    Set myRange = Workbooks(KGRReport).Worksheets(spreadSheetName).Range("B2:H" & lastrowinSpreadSheet).SpecialCells(xlVisible)
    

    In the function, use on error goto xxxx. When error return nothing from the function and use "if myRange is not nothing then" to ignore the error cells.

    0 讨论(0)
  • 2020-12-19 09:00

    Neither of the responses below worked for me. Here is what I finally found that worked:

    Sub fileterissues()
    
    Dim VisibleRows as Long
    
    ‘Some code here
    
    With Sheets(ws1).Range(“myrange”)
    .Autofilter Field:=myfieldcolumn, criteria:=myfiltercriteria
    VisibleRows = Application.Worksheetfunction.Subtotal(103, sheets(1).mycolumnfieldrange)
    If VisibleRows = 0 then Resume Next
    End with
    
    ‘More code
    
    End sub
    
    0 讨论(0)
  • 2020-12-19 09:07

    An approach without the error handling

    It is possible to build the AutoFilter in a way that does not throw the error if nothing is found. The trick is to include the header row in the call to the SpecialCells. This will ensure that at least 1 row is visible even if nothing is found (Excel will not hide the header row). This prevents the error from jamming up execution and gives you a set of cells to check if data was found.

    To check if the resulting range has data, you need to check Rows.Count > 1 Or Areas.Count > 1. This handles the two possible cases where your data is found directly under the header or in a discontinuous range below the header row. Either result means that the AutoFilter found valid rows.

    Once you check that data was found, you can then do the desired call to SpecialCells on the data only without concern for an error.

    Sample data [column C (field 2) will be filtered]:

    Sub TestAutoFilter()
    
        'this is your block of data with headers
        Dim rngDataAndHeader As Range
        Set rngDataAndHeader = Range("B2").CurrentRegion
    
        'this will knock off the header row if you want data only
        Dim rngData As Range
        Set rngData = Intersect(rngDataAndHeader, rngDataAndHeader.Offset(1))
    
        'autofilter
        rngDataAndHeader.AutoFilter Field:=2, Criteria1:=64
    
        'get the visible cells INCLUDING the header row
        Dim rngVisible As Range
        Set rngVisible = rngDataAndHeader.SpecialCells(xlCellTypeVisible)
    
        'check if there are more than 1 rows or if there are multiple areas (discontinuous range)
        If rngVisible.Rows.Count > 1 Or rngVisible.Areas.Count > 1 Then
            Debug.Print "found data"
    
            'data is available, this call cannot throw an error now
            Set rngVisible = rngData.SpecialCells(xlCellTypeVisible)
    
            'do your normal execution here
            '
            '
            '
        Else
            Debug.Print "only header, no data included"
        End If
    End Sub
    

    Result with Criteria1:=64

    Immediate window: found data

    Result with Criteria1:=0

    Immediate window: only header, no data included

    Other notes:

    • Code includes a separate variable called rngData if you want access to data without headers. This is just an INTERSECT-OFFSET to bump it one row down.
    • For the case where a result was found, code resets rngVisible to be the visible cells in the data only (skips header). Since this call cannot fail now, it is safe without error handling. This gives you a range that matches what you tried the first time but without the chance of getting an erorr. This is not required if you can process the original range rngVisible that includes the headers. If that is true, you can do away with rngData completely (unless you have some other need for it).
    0 讨论(0)
  • 2020-12-19 09:09

    Try error handling like so:

    Dim myRange As Range
    
    On Error Resume Next
    Set myRange = Range("your range here").SpecialCells(xlVisible)
    On Error GoTo 0
    
    If myRange Is Nothing Then
        MsgBox "no cells"
    Else
        'do stuff
    End If
    
    0 讨论(0)
  • 2020-12-19 09:16

    since you use myRange as the real output of the filtering action you could go like follows

    Dim wbKGRR As Workbook  '<== better set variable for workbooks you'll work with: it saves both typing time and possible errors
    Dim ws As Worksheet  '<== better set variable for worksheets you'll work with: it saves both typing time and possible errors
    
    '...
    
    
    Set wbKGRR = Workbooks(KGRReport) '<== better set variable for workbooks: it saves both typing time and possible errors
    Set ws = wbKGRR.Worksheets(spreadSheetName)  '<== better set variable for worksheets you'll work with: it saves both typing time and possible errors
    
    With ws
        With .Range("A1:I" & lastrowinSpreadSheet)
            .AutoFilter Field:=3, Criteria1:=LimitCriteria, Operator:=xlFilterValues 'Do the filtering for Limit
            .AutoFilter Field:=9, Criteria1:=UtilizationCriteria, Operator:=xlFilterValues 'Do the filtering for Bank/NonBank
        End With
        If Application.WorksheetFunction.Subtotal(103, .Columns("B")) > 0 Then Set myRange = .Range("B2:H" & lastrowinSpreadSheet).SpecialCells(xlVisible) '<== myRange will be set only if filtering has left some visible cells
    End With
    
    
    'Clear the template
    'Workbooks(mainwb).Worksheets("Template").Activate '<== no need to activate
    Workbooks(mainwb).Worksheets("Template").Rows(7 & ":" & Rows.Count).Delete
    
    'Copy the filtered data
    ' Workbooks(KGRReport).Activate '<== no need to activate
    If Not myRange Is Nothing Then '<== "myRange" has been set properly if previous Autofilter method has left some visbile cells
        For Each myArea In myRange.Areas
            For Each rw In myArea.Rows
                  strFltrdRng = strFltrdRng & rw.Address & ","
            Next rw
        Next myArea
    
        strFltrdRng = Left(strFltrdRng, Len(strFltrdRng) - 1)
        Set myFltrdRange = Range(strFltrdRng)
        myFltrdRange.Copy
        strFltrdRng = ""
    End If
    

    where I also suggested some workbook and worksheet variable settings to "ease" coding life

    0 讨论(0)
提交回复
热议问题