How to stop RE on autofilter VBA macro

honkin

Active Member
Joined
Mar 20, 2012
Messages
374
Office Version
  1. 2016
Platform
  1. MacOS
I have a number of VBA macros which autofilter, hide certain columns, then copy the results, minus the header row, to another sheet. By and large they work well, but when there is nothing to copy, there is generally a RE on the line indicating the destination sheet

Here is just one of the macros:

VBA Code:
Sub SafeBets()
'
' SafeBets Macro
' This macro will filter for PR, Run Style and Forecast Odds
'
    Dim ws As Worksheet, lc As Long, lr As Long

    Set ws = ActiveSheet
    'range from A1 to last column header and last row
    lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    lr = ws.Cells.Find("*", after:=ws.Range("A1"), LookAt:=xlPart, _
                        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
    With ws.Range("A1", ws.Cells(lr, lc))
        .HorizontalAlignment = xlCenter
        .AutoFilter Field:=24, Criteria1:="~*", Operator:=xlFilterValues
        .AutoFilter Field:=56, Criteria1:="Closer"
        .AutoFilter Field:=63, Criteria1:=">=7"
        .AutoFilter Field:=64, Criteria1:=">=5"
        .AutoFilter Field:=10, Criteria1:=Array("5", "6", "7"), Operator:=xlFilterValues
        .AutoFilter Field:=39, Criteria1:=Array("1", "2", "3", "4"), Operator:=xlFilterValues
        .AutoFilter Field:=5, Criteria1:=">=60"
        .AutoFilter Field:=71, Criteria1:="<>1", Operator:=xlFilterValues
        .AutoFilter Field:=69, Criteria1:="<>1", Operator:=xlFilterValues
        .AutoFilter Field:=27, Criteria1:="<=20"
        If .Rows.Count - 1 > 0 Then
        On Error Resume Next
        .Columns("C:C").EntireColumn.Hidden = True
        .Columns("G:G").EntireColumn.Hidden = True
        .Columns("I:I").EntireColumn.Hidden = True
        .Columns("K:L").EntireColumn.Hidden = True
        .Columns("N:W").EntireColumn.Hidden = True
        .Columns("Y:Z").EntireColumn.Hidden = True
        .Columns("AB:AK").EntireColumn.Hidden = True
        .Columns("AO:AO").EntireColumn.Hidden = True
        .Columns("AQ:BC").EntireColumn.Hidden = True
        .Columns("BE:BJ").EntireColumn.Hidden = True
        .Columns("BM:BP").EntireColumn.Hidden = True
        .Columns("BR:BR").EntireColumn.Hidden = True
        .Columns("BT:CC").EntireColumn.Hidden = True
        .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
        On Error GoTo 0
            Else
                Exit Sub
        End If
    End With
     
    Workbooks("New Results File Active.xlsm").Sheets("Safe Bets 1") _
          .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   
    Application.CutCopyMode = False
End Sub

As indicated, if there is nothing to copy, the RE come on this
VBA Code:
Workbooks("New Results File Active.xlsm").Sheets("Safe Bets 1") _
          .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

Any thoughts as to why this occurs and how to amend the macro so it doesn't happen any further?

Cheers
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Any thoughts as to why this occurs
It occurs because in this line .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy there are no visible cells. An error is actually created at that point & nothing is copied but that is in a part of the code where you have this set so the error is ignored at that point On Error Resume Next
When you get to the line where your error is actually showing there is another error because there is nothing to paste since nothing was copied.

I'm not really sure why you have all that hiding columns section within the On Error Resume Next section?

how to amend the macro so it doesn't happen any further?
I haven't tried to completely re-write the code but a quick fix I think would be to add these blue lines where shown.

Rich (BB code):
.Columns("BT:CC").EntireColumn.Hidden = True
If .Columns(1).SpecialCells(xlVisible).Count > 1 Then
  .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
Else
  Exit Sub
End If
       On Error GoTo 0
 
Upvote 0
Solution
It occurs because in this line .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy there are no visible cells. An error is actually created at that point & nothing is copied but that is in a part of the code where you have this set so the error is ignored at that point On Error Resume Next
When you get to the line where your error is actually showing there is another error because there is nothing to paste since nothing was copied.

I'm not really sure why you have all that hiding columns section within the On Error Resume Next section?


I haven't tried to completely re-write the code but a quick fix I think would be to add these blue lines where shown.

Rich (BB code):
.Columns("BT:CC").EntireColumn.Hidden = True
If .Columns(1).SpecialCells(xlVisible).Count > 1 Then
  .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
Else
  Exit Sub
End If
       On Error GoTo 0
cheers Peter

To be honest, no valid reason the hide columns section is where it is, other than to say it is a carry over from some macros used in other workbooks. I simply copied the relevant sections and amended which columns to hide. As you may have guessed, correctly structuring VBA macros is not my strong point.

I'd be happy for them not to be there if it means tidying up the code. Was just reticent to fix what appeared to be working and just focused on the part which seemed obviously incorrect

Here it is amended

VBA Code:
Sub SafeBets()
'
' SafeBets Macro
' This macro will filter for PR, Run Style and Forecast Odds
'
    Dim ws As Worksheet, lc As Long, lr As Long

    Set ws = ActiveSheet
    'range from A1 to last column header and last row
    lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    lr = ws.Cells.Find("*", after:=ws.Range("A1"), LookAt:=xlPart, _
                        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
    With ws.Range("A1", ws.Cells(lr, lc))
        .HorizontalAlignment = xlCenter
        .AutoFilter Field:=24, Criteria1:="~*", Operator:=xlFilterValues
        .AutoFilter Field:=56, Criteria1:="Closer"
        .AutoFilter Field:=63, Criteria1:=">=7"
        .AutoFilter Field:=64, Criteria1:=">=5"
        .AutoFilter Field:=10, Criteria1:=Array("5", "6", "7"), Operator:=xlFilterValues
        .AutoFilter Field:=39, Criteria1:=Array("1", "2", "3", "4"), Operator:=xlFilterValues
        .AutoFilter Field:=5, Criteria1:=">=60"
        .AutoFilter Field:=71, Criteria1:="<>1", Operator:=xlFilterValues
        .AutoFilter Field:=69, Criteria1:="<>1", Operator:=xlFilterValues
        .AutoFilter Field:=27, Criteria1:="<=20"
        If .Rows.Count - 1 > 0 Then
        On Error Resume Next
        .Columns("C:C").EntireColumn.Hidden = True
        .Columns("G:G").EntireColumn.Hidden = True
        .Columns("I:I").EntireColumn.Hidden = True
        .Columns("K:L").EntireColumn.Hidden = True
        .Columns("N:W").EntireColumn.Hidden = True
        .Columns("Y:Z").EntireColumn.Hidden = True
        .Columns("AB:AK").EntireColumn.Hidden = True
        .Columns("AO:AO").EntireColumn.Hidden = True
        .Columns("AQ:BC").EntireColumn.Hidden = True
        .Columns("BE:BJ").EntireColumn.Hidden = True
        .Columns("BM:BP").EntireColumn.Hidden = True
        .Columns("BR:BR").EntireColumn.Hidden = True
        .Columns("BT:CC").EntireColumn.Hidden = True
        If .Columns(1).SpecialCells(xlVisible).Count > 1 Then
        .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
        Else
            Exit Sub
        End If
            On Error GoTo 0
        End If
    End With
     
    Workbooks("New Results File Active.xlsm").Sheets("Safe Bets 1") _
          .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   
    Application.CutCopyMode = False
End Sub

I'l have no way of know if it works correctly until next time there is nothing to copy in any of the macros. The sheets these run on have many hundreds of rows and are downloaded daily, so I will know in a day or so

cheers mate
 
Upvote 0
I'l have no way of know if it works correctly until next time there is nothing to copy in any of the macros. The sheets these run on have many hundreds of rows and are downloaded daily, so I will know in a day or so
Let's see how it goes for a few days at least then.
 
Upvote 0
Let's see how it goes for a few days at least then.
Peter, that appeared to work really this morning in the handful of files which were download, so am happy to mark it as a solution. Thanks so much for your help. It really does save a lot of time

cheers
 
Upvote 0
You're welcome. Thanks for the follow-up. :)
 
Upvote 0

Forum statistics

Threads
1,214,626
Messages
6,120,602
Members
448,974
Latest member
ChristineC

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