Optimising a Macro

[darcus]

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:

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

 

[darcus]

Thank you for that JackDanIce


That's brilliant.


Makes perfect sense to me.


Next step is to get the code to read a column of cells (which can change in number).


I store my list of cells using the following code on the sheet called SCRATCH first:

Sub ListFolio()


    Sheets("SCRATCH").Select
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    Sheets("Invoice Data").Select
    Cells.Select
    Selection.EntireColumn.Hidden = False
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AE$14922").AutoFilter Field:=8, Criteria1:= _
        "Grand Total for Invoice"
    ActiveSheet.Range("$A$1:$AE$14922").AutoFilter Field:=20, Criteria1:="="
    Range("C1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("SCRATCH").Select
    Range("A1").Select
    ActiveSheet.Paste
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    ActiveWorkbook.Worksheets("SCRATCH").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("SCRATCH").Sort.SortFields.Add Key:=Range("A1:A377" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("SCRATCH").Sort
        .SetRange Range("A1:A377")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A$1:$A$377").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("A1").Select
End Sub

This basically creates a list of Folios which I feed into the Statement_v1 code, one at a time.


I've got the code to make a PDF of the page and save it.


I just need to get a bit of code which reads all the cells in Column A (until I get a blank - at which point it stops) and uses the contents of that cell and sends it to the Statement_v1 code - This I assume goes into

var=.Range("A2").Value

Somehow...


I know I have to use a loop like

      Do Until IsEmpty(ActiveCell)
         ' Insert code here.
         ActiveCell.Offset(1, 0).Select
      Loop

But I'm stuck again - need to read this book!!!

See comments added:

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

 

[JackDanIce]

Glad it helps.