VBA code error: out of memory

jkauhausen

New Member
Joined
Oct 5, 2014
Messages
1
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 :)

Code:
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

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Does it help if you avoid all the Selecting?

Code:
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
 

Forum statistics

Threads
1,082,336
Messages
5,364,705
Members
400,811
Latest member
MSBINinja

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top