Making Code Efficient (Using to many MegaBytes)

[danman5005]

Hi Everyone,



Was able to record and tweek some VBA code, but found that I created a VBA monster that is 20 Mega Bytes. Wanted to see if anyone had any idea in how to thin out the code.-Thanks.


Sub MultiLender_Pools()

Sheets("MultiLender_Pools").Select
ActiveSheet.Range("E4").Select
ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

Sheets("SQL").Select
ActiveSheet.Range("E4").Select
Selection.AutoFilter

ActiveSheet.Range("$E$4:$M$355").AutoFilter Field:=7, Criteria1:="Y", _
Operator:=xlAnd

ActiveSheet.Range("$E$4:$M$355").AutoFilter Field:=9, Criteria1:= _
xlFilterThisMonth, Operator:=xlFilterDynamic


ActiveSheet.Range("E4").Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("MultiLender_Pools").Select
ActiveSheet.Range("E4").Select
ActiveSheet.Paste
ActiveSheet.Columns("E:M").AutoFit
Sheets("SQL").Select
Selection.End(xlUp).Select
Application.CutCopyMode = False

Sheets("SQL").Select
ActiveSheet.Range("E4").Select
Selection.AutoFilter

ActiveSheet.Range("$E$4:$M$355").AutoFilter Field:=8, Criteria1:="Y", _
Operator:=xlAnd

ActiveSheet.Range("$E$4:$M$355").AutoFilter Field:=9, Criteria1:= _
xlFilterThisMonth, Operator:=xlFilterDynamic

ActiveSheet.Range("E4").Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("MultiLender_Pools").Select
ActiveSheet.Range("E4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste


End Sub


Sub Empty_Shells()
' Empty_Shells Macro
Sheets("Empty_Shells").Select
ActiveSheet.Range("E4").Select
ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Sheets("SQL").Select
ActiveSheet.Range("E4").Select
Selection.AutoFilter
ActiveSheet.Range("$E$4:$M$58").AutoFilter Field:=3, Criteria1:="=$-" _
, Operator:=xlAnd

ActiveSheet.Range("$E$4:$M$355").AutoFilter Field:=7, Criteria1:="<>Y", _
Operator:=xlAnd

ActiveSheet.Range("$E$4:$M$355").AutoFilter Field:=8, Criteria1:="<>Y", _
Operator:=xlAnd

Selection.End(xlDown).Select
ActiveSheet.Range("E4").Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Empty_Shells").Select
ActiveSheet.Range("E4").Select
ActiveSheet.Paste

ActiveSheet.Columns("E:M").AutoFit
End Sub

 

[Ruddles]

That code isn't 20Mb in size. How big are the worksheets? Do a Ctrl-End in each one and see where Excel thinks the last cell is.

 

[s hal]

While I also dont see how this is such a large amount of code, I believe I got rid of nearly everything that wasn't necessary...

Sub MultiLender_Pools()
With Sheets("MultiLender_Pools")
    .Range(.Range("E4"), .Range("E4").End(xlToRight).End(xlDown)).ClearContents
End With
With Sheets("SQL")
    .Range("E4").AutoFilter
    .Range("$E$4:$M$355").AutoFilter Field:=7, Criteria1:="Y", Operator:=xlAnd
    .Range("$E$4:$M$355").AutoFilter Field:=9, Criteria1:=xlFilterThisMonth, Operator:=xlFilterDynamic
    .Range(.Range("E4"), .Range("E4").End(xlDown).End(xlToRight)).Copy
End With
With Sheets("MultiLender_Pools")
    .Range("E4").Paste
    .Columns("E:M").AutoFit
End With
With Sheets("SQL")
    .Range("E4").AutoFilter
    .Range("$E$4:$M$355").AutoFilter Field:=8, Criteria1:="Y", Operator:=xlAnd
    .Range("$E$4:$M$355").AutoFilter Field:=9, Criteria1:=xlFilterThisMonth, Operator:=xlFilterDynamic
    .Range("E4").Offset(1, 0).Select
    .Range(Selection, Selection.End(xlDown).End(xlToRight)).Copy
End With
Sheets("MultiLender_Pools").Range("E4").End(xlDown).Offset(1, 0).Paste
 

End Sub

Sub Empty_Shells()
' Empty_Shells Macro
With Sheets("Empty_Shells")
    .Range(.Range("E4"), .Range("E4").End(xlToRight).End(xlDown)).ClearContents
End With
    
With Sheets("SQL")
    .Range("$E$4:$M$58").AutoFilter Field:=3, Criteria1:="=$-", Operator:=xlAnd
    .Range("$E$4:$M$355").AutoFilter Field:=7, Criteria1:="<>Y", Operator:=xlAnd
    .Range("$E$4:$M$355").AutoFilter Field:=8, Criteria1:="<>Y", Operator:=xlAnd
    .Range(.Range("E4"), .Range("E4").End(xlDown).End(xlToRight)).Copy
End With
With Sheets("Empty_Shells")
    .Range("E4").Paste
    .Columns("E:M").AutoFit
End With
    
End Sub

 

[Garry2Rs]

Here's my cleanup...

Sub MultiLender_Pools()
    Sheets("MultiLender_Pools").Range("E4").CurrentRegion.ClearContents
    With Sheets("SQL")
        .Range("E4").AutoFilter
        With .Range("$E$4:$M$355")
            .AutoFilter Field:=7, Criteria1:="Y", Operator:=xlAnd
            .AutoFilter Field:=9, Criteria1:=xlFilterThisMonth, Operator:=xlFilterDynamic
        End With
        .Range("E4").CurrentRegion.Copy Destination:=Sheets("MultiLender_Pools").Range("E4")
        Application.CutCopyMode = False
        
        .Range("E4").AutoFilter
        With .Range("$E$4:$M$355")
            .AutoFilter Field:=8, Criteria1:="Y", Operator:=xlAnd
            .AutoFilter Field:=9, Criteria1:= xlFilterThisMonth, Operator:=xlFilterDynamic
        End With
        .Range("E4").CurrentRegion.Copy _
            Destination:=Sheets("MultiLender_Pools").Range("E4").End(xlDown).Offset(1)
    End With 'Sheets("SQL")
    Sheets("MultiLender_Pools").Columns("E:M").AutoFit
End Sub


Sub Empty_Shells()
    ' Empty_Shells Macro
    Sheets("Empty_Shells").Range("E4").CurrentRegion.ClearContents
    With Sheets("SQL")
        .Range("E4").AutoFilter
        .Range("$E$4:$M$58").AutoFilter Field:=3, Criteria1:="=$-", Operator:=xlAnd
        With .Range("$E$4:$M$355")
            .AutoFilter Field:=7, Criteria1:="<>Y", Operator:=xlAnd
            .AutoFilter Field:=8, Criteria1:="<>Y", Operator:=xlAnd
        End With
        .Range("E4").CurrentRegion.Copy Destination:=Sheets("Empty_Shells").Range("E4")
    End With 'Sheets("SQL")
    Sheets("Empty_Shells").Columns("E:M").AutoFit
End Sub