Optimising a Macro

D

darcus

New Member
Joined
Jun 30, 2014
Messages
29
Hi
I have put together the following VBA code from a macro that I recorded.
It works well, but I'm wondering if there's a quicker and better way of doing this:
Code: 
Sub Statement()

    Sheets("Statement").Select
    Range("C10:F41").Select
    Selection.ClearContents
    Range("C9").Select
    Sheets("Invoice Data").Select
    ActiveSheet.Range("$A$1:$AE$65535").AutoFilter Field:=8, Criteria1:="Grand Total for Invoice"
    ActiveSheet.Range("$A$1:$AE$65535").AutoFilter Field:=3, Criteria1:=Sheets("Statement").Range("A2").Value
    ActiveSheet.Range("$A$1:$AE$65535").AutoFilter Field:=20, Criteria1:="="
    Columns("C:L").Select
    Selection.EntireColumn.Hidden = True
    Columns("N:R").Select
    Selection.EntireColumn.Hidden = True
    Columns("T:AE").Select
    Selection.EntireColumn.Hidden = True
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Statement").Select
    Range("C9").Select
    ActiveSheet.Paste
    Sheets("Statement").Select
End Sub

I'm sure it's too long winded a way of doing it, but it seemed to make sense and does what I want it to...

d
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Sort by date Sort by votes
darcus said:
Hi
I have put together the following VBA code from a macro that I recorded.
It works well, but I'm wondering if there's a quicker and better way of doing this:
Code: 
Sub Statement()

    Sheets("Statement").Select
    Range("C10:F41").Select
    Selection.ClearContents
    Range("C9").Select
    Sheets("Invoice Data").Select
    ActiveSheet.Range("$A$1:$AE$65535").AutoFilter Field:=8, Criteria1:="Grand Total for Invoice"
    ActiveSheet.Range("$A$1:$AE$65535").AutoFilter Field:=3, Criteria1:=Sheets("Statement").Range("A2").Value
    ActiveSheet.Range("$A$1:$AE$65535").AutoFilter Field:=20, Criteria1:="="
    Columns("C:L").Select
    Selection.EntireColumn.Hidden = True
    Columns("N:R").Select
    Selection.EntireColumn.Hidden = True
    Columns("T:AE").Select
    Selection.EntireColumn.Hidden = True
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Statement").Select
    Range("C9").Select
    ActiveSheet.Paste
    Sheets("Statement").Select
End Sub

I'm sure it's too long winded a way of doing it, but it seemed to make sense and does what I want it to...

d
Click to expand...
Hi darcus,

I am not 100% certain about the filtering part, however try out the following in a COPY of your workbook:

Code: 
Sub StatementNew()
Dim InvoiceData As Worksheet, Statement As Worksheet
Set Statement = Sheets("Statement")
Set InvoiceData = Sheets("Invoice Data")
    Statement.Range("C10:F41").ClearContents
        With InvoiceData
            LastRow = InvoiceData.Cells(Rows.Count, "A").End(xlUp).Row
            LastCol = InvoiceData.Cells(1, Columns.Count).End(xlToLeft).Column
                .Range("$A$1:$AE$1").AutoFilter Field:=8, Criteria1:="Grand Total for Invoice"
                .Range("$A$1:$AE$1").AutoFilter Field:=3, Criteria1:=Sheets("Statement").Range("A2").Value
                .Range("$A$1:$AE$1").AutoFilter Field:=20, Criteria1:="="
                .Columns("C:L").EntireColumn.Hidden = True
                .Columns("N:R").EntireColumn.Hidden = True
                .Columns("T:AE").EntireColumn.Hidden = True
                .Range("A1", Cells(LastRow, LastCol)).Copy Destination:=Sheets("Statement").Range("C9")
        End With
            Sheets("Statement").Select
End Sub
 
Last edited:
Upvote 0
Untested, however, try:
Code: 
Sub Statement_v1()

    Dim var     As Variant
    Dim x       As Long
    Dim y       As Long
    
    Set wks = Sheets("Invoice Data")
    
    Application.ScreenUpdating = False
    
    With Sheets("Statement")
        var = .range("A2").value
        .range("C10:F41").ClearContents
    End With
    
    With Sheets("Invoice Data")
        If .AutoFilterMode Then .ShowAllData
        x = .Cells(.rows.count, 1).End(xlUp).row
        y = .Cells(1, .Columns.count).End(xlToLeft).Column
        
        With .Cells(1, 1).Resize(x, y)
            .AutoFilter field:=8, Criteria1:="Grand Total for Invoice"
            .AutoFilter field:=3, Criteria1:=var
            .AutoFilter field:=20, Criteria1:="="
        End With
        
        For Each var In Array("C:L", "N:R", "T:AE")
            range(CStr(var)).EntireColumn.Hidden = True
        Next var
        
        .Cells(1, 1).CurrentRegion.Copy
    End With
    
    Sheets("Statement").range("C9").PasteSpecial xlPasteValues
    
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
    
End Sub
 
Last edited:
Upvote 0
Hi Fishboy,

Thank you for that.

I tried the code, but it stops here:
Code: 
.Range("A1", Cells(LastRow, LastCol)).Copy Destination:=Sheets("Statement").Range("C9")

Highlights it in Yellow - and doesn't do anything on the sheet - no idea whats going on...
 
Upvote 0
darcus said:
Hi Fishboy,

Thank you for that.

I tried the code, but it stops here:
Code: 
.Range("A1", Cells(LastRow, LastCol)).Copy Destination:=Sheets("Statement").Range("C9")

Highlights it in Yellow - and doesn't do anything on the sheet - no idea whats going on...
Click to expand...
Hmm, how about this slightly tweaked version:

Rich (BB code): 
Sub StatementNew()
Dim InvoiceData As Worksheet, Statement As Worksheet
Set Statement = Sheets("Statement")
Set InvoiceData = Sheets("Invoice Data")
    Statement.Range("C10:F41").ClearContents
        With InvoiceData
            LastRow = InvoiceData.Cells(Rows.Count, "A").End(xlUp).Row
            LastCol = InvoiceData.Cells(1, Columns.Count).End(xlToLeft).Column
                .Range("$A$1:$AE$1").AutoFilter Field:=8, Criteria1:="Grand Total for Invoice"
                .Range("$A$1:$AE$1").AutoFilter Field:=3, Criteria1:=Sheets("Statement").Range("A2").Value
                .Range("$A$1:$AE$1").AutoFilter Field:=20, Criteria1:="="
                .Columns("C:L").EntireColumn.Hidden = True
                .Columns("N:R").EntireColumn.Hidden = True
                .Columns("T:AE").EntireColumn.Hidden = True
                .Range("A1", Cells(LastRow, LastCol)).Copy
        End With
            Sheets("Statement").Select
                Range("C9").Paste
End Sub
 
Last edited:
Upvote 0
Hi JackDanIce,

I tried your code and it gives an error:
"Unable to set the Hidden property of the Range class"

and then stops at
Code: 
Range(CStr(var)).EntireColumn.Hidden = True

I am using Excel 2007 - so maybe there's an issue there...

d
 
Upvote 0
Hi Fishboy,

Got the following error:
"Method 'Range' of object '_Worksheet' failed"

It stops at
Code: 
.Range("A1", Cells(LastRow, LastCol)).Copy
 
Upvote 0
Try now:
Code: 
Sub Statement_v1()

    Dim var     As Variant
    Dim x       As Long
    Dim y       As Long
    
    Set wks = Sheets("Invoice Data")
    
    Application.ScreenUpdating = False
    
    With Sheets("Statement")
        var = .range("A2").value
        .range("C10:F41").ClearContents
    End With
    
    With Sheets("Invoice Data")
        If .AutoFilterMode Then .ShowAllData
        x = .Cells(.rows.count, 1).End(xlUp).row
        y = .Cells(1, .Columns.count).End(xlToLeft).Column
        
        With .Cells(1, 1).Resize(x, y)
            .AutoFilter field:=8, Criteria1:="Grand Total for Invoice"
            .AutoFilter field:=3, Criteria1:=var
            .AutoFilter field:=20, Criteria1:="="
        End With
        
        For Each var In Array("C:L", "N:R", "T:AE")
            .range(CStr(var)).EntireColumn.Hidden = True
        Next var
        
        .Cells(1, 1).CurrentRegion.Copy
    End With
    
    Sheets("Statement").range("C9").PasteSpecial xlPasteValues
    
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
    
End Sub
 
Upvote 0
Hi JackDanIce!

Thank you!

That worked a treat!

Now to figure out your code and what it's actually doing so that I can learn.

Thank you again.
d

JackDanIce said:
Try now:
Code: 
Sub Statement_v1()

    Dim var     As Variant
    Dim x       As Long
    Dim y       As Long
    
    Set wks = Sheets("Invoice Data")
    
    Application.ScreenUpdating = False
    
    With Sheets("Statement")
        var = .range("A2").value
        .range("C10:F41").ClearContents
    End With
    
    With Sheets("Invoice Data")
        If .AutoFilterMode Then .ShowAllData
        x = .Cells(.rows.count, 1).End(xlUp).row
        y = .Cells(1, .Columns.count).End(xlToLeft).Column
        
        With .Cells(1, 1).Resize(x, y)
            .AutoFilter field:=8, Criteria1:="Grand Total for Invoice"
            .AutoFilter field:=3, Criteria1:=var
            .AutoFilter field:=20, Criteria1:="="
        End With
        
        For Each var In Array("C:L", "N:R", "T:AE")
            .range(CStr(var)).EntireColumn.Hidden = True
        Next var
        
        .Cells(1, 1).CurrentRegion.Copy
    End With
    
    Sheets("Statement").range("C9").PasteSpecial xlPasteValues
    
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
    
End Sub
Click to expand...
 
Upvote 0
See comments added:
Code: 
Sub Statement_v1()
        
    'Dim variables
    Dim wks     As Worksheet
    Dim var     As Variant
    Dim x       As Long
    Dim y       As Long
    
    Set wks = Sheets("Invoice Data")
    
    'Turn screenupdating off
    Application.ScreenUpdating = False
    
    'Capture value of A2 and clear range C10:F41 of sheet Statement
    With Sheets("Statement")
        var = .Range("A2").Value
        .Range("C10:F41").ClearContents
    End With
    
    'Work with sheet Invoice Data (worksheet object)
    With Sheets("Invoice Data")
        If .AutoFilterMode Then .ShowAllData                'Show all data, if filter mode is on
        x = .Cells(.Rows.Count, 1).End(xlUp).Row            'Determine last used row based on column A (1)
        y = .Cells(1, .Columns.Count).End(xlToLeft).Column  'Determine last used column based on row 1
        
        With .Cells(1, 1).Resize(x, y) 'With cell A1 resized by x rows and y columns (that is Range A1 to cells(X,y), apply filters
            .AutoFilter field:=8, Criteria1:="Grand Total for Invoice"
            .AutoFilter field:=3, Criteria1:=var
            .AutoFilter field:=20, Criteria1:="="
        End With
        
        'Loop through string variables in array and use as arguments for column ranges to hide
        For Each var In Array("C:L", "N:R", "T:AE")
            .Range(CStr(var)).EntireColumn.Hidden = True
        Next var
                
        'Copy filtered area
        .Cells(1, 1).CurrentRegion.Copy
    End With
    
    'Paste to destination
    Sheets("Statement").Range("C9").PasteSpecial xlPasteValues
    
    With Application
        .CutCopyMode = False    'Turn "marching ants" after copy off
        .ScreenUpdating = True  'Turn screen updating on
    End With
    
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
Filter data set to #N/A, skip step entirely if none
Replies
3
Views
283
RoryA
RoryA
S
  • Question Question
How to streamline?
Replies
2
Views
343
sachavez
S
R
  • Question Question
Help auto filtering dynamic data table
Replies
1
Views
138
russelldt
R
J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
239
rlv01
R
M
  • Question Question
Highlighting certain cells after appling filter
Replies
2
Views
362
Motoracer88
M

Forum statistics

Threads
1,223,227
Messages
6,170,849
Members
452,361
Latest member
d3ad3y3

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