Macro with Filter Issue

R

Robert13

New Member
Joined
Apr 16, 2013
Messages
16
I am trying to generate two reports. There are 50 divisions. In the first grouping, 4 divisions are shown as listed in red below. This macro is working well for my purposes. However, when I do the same sort of thing to run the other report, the array of the other 46 divisions is too many (i get an error). The listing of the other 46 also changes frequently so I can't do a one time list. What I was trying to do was in the filter select all and then deselect the 4 that are not part of this report. I hope I was able to explain this properly. Any help would be appreciated. Thank you.


Sub Sixty_Day_On()
'
' Sixty_Day_On_BC Macro
'


'
Range("C2").Select
ActiveSheet.Range("$A$5:$AN$600").AutoFilter Field:=3, Criteria1:=Array( _
"Central", "East", "Schedule", "BC-East F/E", "BC-West"), Operator:= _
xlFilterValues
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 21
Range("A5:az700").Select
Selection.Sort Key1:=Range("W1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A2").Select
Columns("X:X").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("AB2").Select
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
Columns("C:D").Select
Selection.EntireColumn.Hidden = True
Columns("G:J").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 20
Columns("U:U").Select
Selection.EntireColumn.Hidden = True
Columns("Y:AB").Select
Selection.EntireColumn.Hidden = True
Columns("AC:AI").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("South Region Schedule").Copy Before:=Sheets(1)
Sheets("South Region Schedule (2)").Name = "Monthly Schedule BC"
Range("S1:T602,A1:R602,u1:x602").Select
Dim c As Range
For Each c In Selection.SpecialCells(xlCellTypeVisible)
c.Value = c.Value
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Range("X2:X3,E2:e2").Select
Selection.ClearContents
ActiveWindow.Zoom = 90
Sheets(1).Buttons.Delete
Range("A1").Select
Sheets("Monthly Schedule BC").Select
Sheets("Monthly Schedule BC").Move
End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
Robert13, it helps readability if you use code tags. I cleaned up your code to removed all the unneeded .select and .activate properties the recorder tosses in. Although untested, see if the changes help eliminate your problem. All those .Select statements take up memory and slow your macro:
Code: 
' Sixty_Day_On_BC Macro
Sub Sixty_Day_On()

    With Range("C2")
        .Range("$A$5:$AN$600").AutoFilter Field:=3, Criteria1:=Array( _
                "Central", "East", "Schedule", "BC-East F/E", "BC-West"), Operator:= _
                xlFilterValues
    End With
    With Range("A5:az700")
        .Sort Key1:=Range("W1"), Order1:=xlAscending, Header:=xlYes, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
    With Range("A2").Columns("X:X")
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Range("AB2").Columns("C:D")
        .EntireColumn.Hidden = True
    End With
    Columns("G:J").EntireColumn.Hidden = True
    Columns("U:U").EntireColumn.Hidden = True
    Columns("Y:AB").EntireColumn.Hidden = True
    Columns("AC:AI").EntireColumn.Hidden = True
    ActiveWindow.ScrollColumn = 5
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Sheets("South Region Schedule").Copy Before:=Sheets(1)
    Sheets("South Region Schedule (2)").Name = "Monthly Schedule BC"
    With Range("S1:T602,A1:R602,u1:x602")
        Dim c As Range
        For Each c In .SpecialCells(xlCellTypeVisible)
        c.Value = c.Value
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Range("X2:X3,E2:e2").ClearContents
    ActiveWindow.Zoom = 90
    Sheets(1).Buttons.Delete
    Sheets("Monthly Schedule BC").Move
End Sub
 
Upvote 0
I appreciate it. I am just learning some of this. However, my main issue is the array listed above. What is the best way to have 46 other divisions dynamically selected? In my first iteration I was deselecting all and then just selecting the 4 I need. Now I need to select all and just deselect the four I don't need.
 
Upvote 0
Keeping your current filter in place, you could delete all the visible rows of that filter, remove the autofilter, sort what's left and you have the basis of your second report.
So instead of moving:
Sheets("Monthly Schedule BC")
at the end, copy it instead to get your first report, then do the above, and move that one for your second report.
 
Upvote 0
I see what you are saying. I am still working through the first post but I like your idea. Thank you.
 
Upvote 0
Best suggestion I can make is to build the array dynamically using a 'For Each' loop. An untested example of what I am saying is below:
Code: 
' Sixty_Day_On_BC Macro
Sub Sixty_Day_On()
    
    Dim paramArr() As String
    Dim listZones As String
    Dim enteredValue As Boolean
    Dim k As Long
    
    With Range("C2")
        For Each zone in listZones
            'Acquire the list somehow...
            If Len(Join(paramArr)) <= 0 Then
                ReDim Preserve paramArr(0)    ' Adjust array size up by one row
                paramArr(0) = zone   ' Record in array
            Else
                ' Check for existence in array - add only once
                For k = 0 To UBound(paramArr)    ' Array is zero-based
                    If zone = paramArr(k) Then
                        enteredVal = True
                    End If
                Next k
                If Not enteredVal Then
                    ReDim Preserve paramArr(UBound(paramArr) + 1)   ' Adjust array size up by one row
                    paramArr(UBound(paramArr)) = .Range("A" & i).Value  ' Record in array
                End If
            End If            
        Next zone
        .Range("$A$5:$AN$600").AutoFilter Field:=3, Criteria1:=Array( _
                "Central", "East", "Schedule", "BC-East F/E", "BC-West"), Operator:= _
                xlFilterValues
    End With
    
    With Range("A5:az700")
        .Sort Key1:=Range("W1"), Order1:=xlAscending, Header:=xlYes, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
    With Range("A2").Columns("X:X")
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Range("AB2").Columns("C:D")
        .EntireColumn.Hidden = True
    End With
    Columns("G:J").EntireColumn.Hidden = True
    Columns("U:U").EntireColumn.Hidden = True
    Columns("Y:AB").EntireColumn.Hidden = True
    Columns("AC:AI").EntireColumn.Hidden = True
    ActiveWindow.ScrollColumn = 5
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Sheets("South Region Schedule").Copy Before:=Sheets(1)
    Sheets("South Region Schedule (2)").Name = "Monthly Schedule BC"
    With Range("S1:T602,A1:R602,u1:x602")
        Dim c As Range
        For Each c In .SpecialCells(xlCellTypeVisible)
        c.Value = c.Value
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Range("X2:X3,E2:e2").ClearContents
    ActiveWindow.Zoom = 90
    Sheets(1).Buttons.Delete
    Sheets("Monthly Schedule BC").Move
End Sub

If it is unlikely to have a duplicate value or the error checking is unneeded, you can chop that part out.

EDIT: Forgot a piece!
Code: 
.Range("$A$5:$AN$600").AutoFilter Field:=3, Criteria1:=paramArr, Operator:= _
                xlFilterValues
 
Last edited:
Upvote 0
James - I appreciate all your help. I am just testing and modifying the fist part. It has really trimmed down the macro but I just want to wrap up that testing before modifying for the second report.
 
Upvote 0
No problem. I come here for help a lot and like to pass it on. I will get an email notice when you reply.
 
Upvote 0
James - is it possible to do as I thought, to just select all in the filter and then deselect the four I don't want. Why will an array that way be any different (as in too large - the error I received before).
 
Upvote 0
It won't. I do not know of any limitations to the array from MS docs, so I am assuming that it must be memory related. If there is an actual limit, these won't help. If there isn't an actual limit, these efforts aren't wasted.

The advantage of the dynamic array is that no matter what changes in the list used, it will handle it without needing to rewrite that part of the macro. It was addressing "The listing of the other 46 also changes frequently so I can't do a one time list." How the list is built was not in the original posted code, so I only put a comment in as a reminder.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Issue with Macros and renaming files
Replies
6
Views
479
kevin9999
K
G
  • Solved
How do I automatically insert into next blank row..
Replies
2
Views
524
ghrek
G
C
  • Solved
Automation error The Object invoked has disconnected from its clients.
Replies
7
Views
670
cstuder
C
S
  • Question
Macro deleting a column
Replies
1
Views
290
Joe4
Joe4
M
  • Question
Loop the Macro to next row until end of sheet
Replies
2
Views
561
rollis13
rollis13

Forum statistics

Threads
1,214,649
Messages
6,120,732
Members
448,987
Latest member
marion_davis

Share this page

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