VBA code error: out of memory

[jkauhausen]

Hi all,

I am a newbie to VBA> Im am trying to write a code that uses an autofilter to help me select and copy groups (Joey, Cub, Scout, Venturer, Rover, Leader) from my main worksheet ("ALL") and paste the data associated with the group onto a separate worksheet (named after the group) in the same workbook.

I have managed to write a code that can work, but Excel is now telling me that it is out of memory as it is performing the sequence.

My question to all VBA experts out there is: How can I reduce and simplify my code so that it uses less memory and goes a bit faster.

Any help would be GREATLY appreciated!!

Thanks in advance

Private Sub CommandButton1_Click()

Dim lastRow As Long
Dim ALL As Worksheet
Dim rnstart As Variant
Dim rndata As Variant

Set ALL = Sheets("ALL")

Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("ALL").Activate
Sheets("ALL").AutoFilterMode = False
ActiveSheet.Cells(1, 1).Select


With ALL
Set rnstart = .Range("O5")
Set rndata = .Range(.Range("O5"), .Range("O1000").End(xlUp))
End With

Sheets("JOEY's").Activate
ActiveSheet.Range("A5:AP150").ClearContents
Sheets("CUB's").Activate
ActiveSheet.Range("A5:AP150").ClearContents
Sheets("SCOUT's").Activate
ActiveSheet.Range("A5:AP150").ClearContents
Sheets("VENTURER's").Activate
ActiveSheet.Range("A5:AP150").ClearContents
Sheets("ROVER's").Activate
ActiveSheet.Range("A5:AP150").ClearContents
Sheets("LEADER's").Activate
ActiveSheet.Range("A5:AP150").ClearContents

Sheets("ALL").Activate
ActiveSheet.Cells(1, 1).Select
rnstart.AutoFilter Field:=15, Criteria1:="Joey"
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("JOEY's").Select
ActiveSheet.Cells(5, 1).Select
ActiveSheet.Paste

Sheets("ALL").Activate
rnstart.AutoFilter Field:=15, Criteria1:="Cub"
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("CUB's").Select
ActiveSheet.Cells(5, 1).Select
ActiveSheet.Paste

Sheets("ALL").Activate
rnstart.AutoFilter Field:=15, Criteria1:="Scout"
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("SCOUT's").Select
ActiveSheet.Cells(5, 1).Select
ActiveSheet.Paste

Sheets("ALL").Activate
rnstart.AutoFilter Field:=15, Criteria1:="Venturer"
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("VENTURER's").Select
ActiveSheet.Cells(5, 1).Select
ActiveSheet.Paste


Sheets("ALL").Activate
rnstart.AutoFilter Field:=15, Criteria1:="Rover"
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("ROVER's").Select
ActiveSheet.Cells(5, 1).Select
ActiveSheet.Paste

Sheets("ALL").Activate
rnstart.AutoFilter Field:=15, Criteria1:="Leader"
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("LEADER's").Select
ActiveSheet.Cells(5, 1).Select
ActiveSheet.Paste


Sheets("ALL").Activate
Sheets("ALL").AutoFilterMode = False
Application.CutCopyMode = False
ActiveSheet.Cells(1, 1).Select

Application.ScreenUpdate = True
Application.EnableEvents = True


End Sub

 

[Andrew Poulsom]

Does it help if you avoid all the Selecting?

Private Sub CommandButton1_Click()
    Dim ALL As Worksheet
    Dim rnstart As Variant
    Set ALL = Sheets("ALL")
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Sheets("JOEY's").Range("A5:AP150").ClearContents
    Sheets("CUB's").Range("A5:AP150").ClearContents
    Sheets("SCOUT's").Range("A5:AP150").ClearContents
    Sheets("VENTURER's").Range("A5:AP150").ClearContents
    Sheets("ROVER's").Range("A5:AP150").ClearContents
    Sheets("LEADER's").Range("A5:AP150").ClearContents
    With ALL
        .AutoFilterMode = False
        Set rnstart = .Range("O5")
        rnstart.AutoFilter Field:=15, Criteria1:="Joey"
        .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Sheets("JOEY's").Cells(5, 1)
        rnstart.AutoFilter Field:=15, Criteria1:="Cub"
        .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Sheets("CUB's").Cells(5, 1)
        rnstart.AutoFilter Field:=15, Criteria1:="Scout"
        .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Sheets("SCOUT's").Cells(5, 1)
        rnstart.AutoFilter Field:=15, Criteria1:="Venturer"
        .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Sheets("VENTURER's").Cells(5, 1)
        rnstart.AutoFilter Field:=15, Criteria1:="Rover"
        .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Sheets("ROVER's").Cells(5, 1)
        rnstart.AutoFilter Field:=15, Criteria1:="Leader"
        .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy Sheets("LEADER's").Cells(5, 1)
        .AutoFilterMode = False
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub