Error Trapping if data no longer exists

BSchwan2

Board Regular
Joined
Jun 29, 2010
Messages
89
Hello,

I was wondering how to circumvent the following error. I am repeatedly using Advanced filter to sort my data into different worksheets. I do this about 12 times. However, depending upon the week, certain criteria will be met by no data. I recieve an error on the .Showalldata line, because no data remain after being sorted and deleted from the main page.

Here is a section of my code to give you an idea. Thanks for the help.

Code:
Dim rngSource As Range
    Dim EIO As Worksheet
    Dim EndColumn As Long
    Dim EndRow As Long
    
    Set EIO = ActiveSheet
    EndColumn = EIO.Cells("1", Columns.Count).End(xlToLeft).Column
    EndRow = EIO.Cells(Rows.Count, "A").End(xlUp).Row
    
    Set rngSource = EIO.Range(EIO.Cells(1, 1), EIO.Cells(EndRow, EndColumn))
    
    'LT 6 Mos Closed
    
    With rngSource
        .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
            Sheets("Advanced Filter Criteria").Range("B2:D3"), Unique:=False
        .SpecialCells(xlCellTypeVisible).EntireRow.Copy _
                    Destination:=Worksheets("LT 6 Mos Closed Detail").Range("a1")
        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    
    ActiveSheet.ShowAllData
    
    Set rngSource = Nothing
    EndRow = 0
    EndColumn = 0
    
    'LT 6 Mos Assigned
     
    EIO.Rows("1:1").insert Shift:=xlDown
    
    Worksheets("LT 6 Mos Closed Detail").Rows("1:1").Copy _
        Destination:=EIO.Range("A1")
        
    EndColumn = EIO.Cells("1", Columns.Count).End(xlToLeft).Column
    EndRow = EIO.Cells(Rows.Count, "A").End(xlUp).Row
    
    Set rngSource = EIO.Range(EIO.Cells(1, 1), EIO.Cells(EndRow, EndColumn))
    
    With rngSource
        .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
            Sheets("Advanced Filter Criteria").Range("B9:D10"), Unique:=False
        .SpecialCells(xlCellTypeVisible).EntireRow.Copy _
                    Destination:=Worksheets("LT 6 Mos Assigned Detail").Range("a1")
        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    
    [COLOR=red]EIO.ShowAllData[/COLOR]
    
    Set rngSource = Nothing
    EndRow = 0
    EndColumn = 0
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Maybe (?):

Code:
IF EIO.FilterMode Then
    EIO.ShowAllData
End If

Or
Code:
On Error Resume Next
EIO.ShowAllData
On Error GoTo 0
 
Last edited:
Upvote 0
Code:
Sub avdloop()
    Dim rngSource As Range
    Dim EIO As Worksheet
    Dim EndColumn As Long
    Dim EndRow As Long
    Dim rngCrit As Range
    Dim rngName As Range
    Dim wksArr As Variant, i As Integer
    
        Set EIO = ActiveSheet
        EndColumn = EIO.Cells("1", Columns.Count).End(xlToLeft).Column
        EndRow = EIO.Cells(Rows.Count, "A").End(xlUp).Row
        Set rngSource = EIO.Range(EIO.Cells(1, 1), EIO.Cells(EndRow, EndColumn))
        Set rngName = Worksheets("Adv_Fil_Crit").Range("F2")
           
        wksArr = Array("LT 6 Mos Closed Detail", "LT 6 Mos Assigned Detail", _
        "LT 6 Mos UnAssigned Detail", _
        "6 to 12 Mos Closed Detail", "6 to 12 Mos Assigned Detail", _
        "6 to 12 Mos UnAssigned Detail", _
        "GT 1 Yr Closed Detail", "GT 1 Yr Assigned Detail", , _
        "GT 1 Yr UnAssigned Detail")
           
        For i = LBound(wksArr) To UBound(wksArr)
            While rngName.Value <> ""
                Set rngCrit = Worksheets("Adv_Fil_Crit").Range("G1:J2")
 
                rngName.Resize(, 5).Delete xlUp
                With rngSource
                    .AdvancedFilter Action:=xlFilterInPlace, criteriarange:= _
                         Sheets("Adv_Fil_Crit").Range(rngCrit), Unique:=False
                    .SpecialCells(xlCellTypeVisible).EntireRow.Copy _
                        Destination:=Worksheets(wksArr(i)).Range("a1")
                    .SpecialCells(xlCellTypeVisible).EntireRow.Delete
                End With
                
                Set rngName = Worksheets("Adv_Fil_Crit").Range("F2")
                If EIO.FilterMode Then
                    EIO.ShowAllData
                End If
'Resetting range of data after having deleted it from sheet
                Set rngSource = Nothing
                EndRow = 0
                EndColumn = 0
'Replacing deleted column headings on data set
                EIO.Rows("1:1").insert Shift:=xlDown
                Worksheets(wksArr(i)).Rows("1:1").Copy _
                    Destination:=EIO.Range("A1")
                EndColumn = EIO.Cells("1", Columns.Count).End(xlToLeft).Column
                EndRow = EIO.Cells(Rows.Count, "A").End(xlUp).Row
                Set rngSource = EIO.Range(EIO.Cells(1, 1), EIO.Cells(EndRow, EndColumn))
            Wend
        Next i
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,215
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top