VBA Code Using Too Much RAM!

Chookz

Board Regular
Joined
May 9, 2011
Messages
95
VBA Experts!

I have the following code that is using up all my RAM to the point where it can't get through all worksheets without crashing excel.
It has to run through 50 worksheets, making calculations on about 30 - 40 of them.

Code:
Sub MatchGraphs()


Dim ws As Worksheet
    
For Each ws In Worksheets
If ws.Range("B11").Value <> "" And _
ws.Name <> "RawData" And _
ws.Name <> "PT1" And _
ws.Name <> "PT2" And _
ws.Name <> "Lookups" Then


ws.Activate


'Week Beginning
ActiveSheet.Range("T" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=VLOOKUP(A3, WeekBeginning2013, 2, FALSE)"
Range(Range("T2"), Range("T2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("T2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Team
ActiveSheet.Range("U" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.FormulaR1C1 = _
        "=IFERROR(VLOOKUP(RC[-1], Team2013, 4, FALSE), """")"
Range(Range("U2"), Range("U2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("U2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Round
ActiveSheet.Range("V" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.FormulaR1C1 = _
        "=IFERROR(VLOOKUP(RC[-2], Round2013, 5, FALSE), """")"
Range(Range("V2"), Range("V2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("V2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'Time
ActiveSheet.Range("W" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=IFERROR(GETPIVOTDATA(""Average of Field Time"",'PT1'!$A$1,""Player Name"",$A$1,""Period Name"",""Session"",""Round"",$A$5, ""Team"",$A$4), """")"
Range(Range("W2"), Range("W2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("W2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Distance
ActiveSheet.Range("X" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=IFERROR(GETPIVOTDATA(""Average of Odometer"",'PT1'!$A$1,""Player Name"",$A$1,""Period Name"",""Session"",""Round"",$A$5, ""Team"",$A$4), """")"
Range(Range("X2"), Range("X2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("X2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Threshold Distance
ActiveSheet.Range("Y" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=IFERROR(GETPIVOTDATA(""Average of Threshold Dist"",'PT1'!$A$1,""Player Name"",$A$1,""Period Name"",""Session"",""Round"",$A$5, ""Team"",$A$4), """")"
Range(Range("Y2"), Range("Y2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("Y2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Threshold %
ActiveSheet.Range("Z" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=IFERROR(GETPIVOTDATA(""Average of Threshold %"",'PT1'!$A$1,""Player Name"",$A$1,""Period Name"",""Session"",""Round"",$A$5, ""Team"",$A$4), """")"
Range(Range("Z2"), Range("Z2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("Z2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Work Rate (m/min)
ActiveSheet.Range("AA" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=IFERROR(GETPIVOTDATA(""Average of Meterage / min"",'PT1'!$A$1,""Player Name"",$A$1,""Period Name"",""Session"",""Round"",$A$5, ""Team"",$A$4), """")"
Range(Range("AA2"), Range("AA2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("AA2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Z5 Efforts
ActiveSheet.Range("AB" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=IFERROR(GETPIVOTDATA(""Average of Vel Zone 5 Efforts"",'PT1'!$A$1,""Player Name"",$A$1,""Period Name"",""Session"",""Round"",$A$5, ""Team"",$A$4), """")"
Range(Range("AB2"), Range("AB2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("AB2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Z6 Efforts
ActiveSheet.Range("AC" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=IFERROR(GETPIVOTDATA(""Average of Vel Zone 6 Efforts"",'PT1'!$A$1,""Player Name"",$A$1,""Period Name"",""Session"",""Round"",$A$5, ""Team"",$A$4), """")"
Range(Range("AC2"), Range("AC2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("AC2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Z6 Distance
ActiveSheet.Range("AD" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=IFERROR(GETPIVOTDATA(""Average of Vel Zone 6 Dist"",'PT1'!$A$1,""Player Name"",$A$1,""Period Name"",""Session"",""Round"",$A$5, ""Team"",$A$4), """")"
Range(Range("AD2"), Range("AD2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("AD2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Av. Z6 Effort Dist.
ActiveSheet.Range("AE" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=IFERROR(GETPIVOTDATA(""Average of Vel Zone 6 Avg Effort Dist"",'PT1'!$A$1,""Player Name"",$A$1,""Period Name"",""Session"",""Round"",$A$5, ""Team"",$A$4), """")"
Range(Range("AE2"), Range("AE2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("AE2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Top Speed
ActiveSheet.Range("AF" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=IFERROR(GETPIVOTDATA(""Average of Max Velocity"",'PT1'!$A$1,""Player Name"",$A$1,""Period Name"",""Session"",""Round"",$A$5, ""Team"",$A$4), """")"
Range(Range("AF2"), Range("AF2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("AF2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Accel
ActiveSheet.Range("AG" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=IFERROR(GETPIVOTDATA(""Average of IMA Accel High"",'PT1'!$A$1,""Player Name"",$A$1,""Period Name"",""Session"",""Round"",$A$5, ""Team"",$A$4), """")"
Range(Range("AG2"), Range("AG2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("AG2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Decel
ActiveSheet.Range("AH" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=IFERROR(GETPIVOTDATA(""Average of IMA Decel High"",'PT1'!$A$1,""Player Name"",$A$1,""Period Name"",""Session"",""Round"",$A$5, ""Team"",$A$4), """")"
Range(Range("AH2"), Range("AH2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("AH2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'COD Left
ActiveSheet.Range("AI" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=IFERROR(GETPIVOTDATA(""Average of IMA COD Left High"",'PT1'!$A$1,""Player Name"",$A$1,""Period Name"",""Session"",""Round"",$A$5, ""Team"",$A$4), """")"
Range(Range("AI2"), Range("AI2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("AI2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'COD Right
ActiveSheet.Range("AJ" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=IFERROR(GETPIVOTDATA(""Average of IMA COD Right High"",'PT1'!$A$1,""Player Name"",$A$1,""Period Name"",""Session"",""Round"",$A$5, ""Team"",$A$4), """")"
Range(Range("AJ2"), Range("AJ2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("AJ2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'High Intensity Movements
ActiveSheet.Range("AK" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=IFERROR(GETPIVOTDATA(""Average of High Intensity Movements"",'PT1'!$A$1,""Player Name"",$A$1,""Period Name"",""Session"",""Round"",$A$5, ""Team"",$A$4), """")"
Range(Range("AK2"), Range("AK2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("AK2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Player Load
ActiveSheet.Range("AL" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=IFERROR(GETPIVOTDATA(""Average of Player Load"",'PT1'!$A$1,""Player Name"",$A$1,""Period Name"",""Session"",""Round"",$A$5, ""Team"",$A$4), """")"
Range(Range("AL2"), Range("AL2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("AL2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Player Load/m (x 1000)
ActiveSheet.Range("AM" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=IFERROR(GETPIVOTDATA(""Average of Player Load / m (x1000)"",'PT1'!$A$1,""Player Name"",$A$1,""Period Name"",""Session"",""Round"",$A$5, ""Team"",$A$4), """")"
Range(Range("AM2"), Range("AM2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("AM2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Round Name
ActiveSheet.Range("AN" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "=IFERROR(CONCATENATE(RC[-19], "" "", RC[-18]), """")"
Range(Range("AN2"), Range("AN2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("AN2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


    Dim CHARTDATA As Range
    Set CHARTDATA = Range(Range("X2"), Range("X2").Offset(0, 0).End(xlDown))
    
    Dim XDATA As Range
    Set XDATA = Range(Range("AN2"), Range("AN2").Offset(0, 0).End(xlDown))
    
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveChart.SeriesCollection(1).Values = CHARTDATA
ActiveChart.SeriesCollection(1).XValues = XDATA


    Dim CHARTDATA2 As Range
    Set CHARTDATA2 = Range(Range("Y2"), Range("Y2").Offset(0, 0).End(xlDown))
    
    Dim XDATA2 As Range
    Set XDATA2 = Range(Range("AN2"), Range("AN2").Offset(0, 0).End(xlDown))
    
ActiveSheet.ChartObjects("Chart 4").Activate
ActiveChart.SeriesCollection(1).Values = CHARTDATA2
ActiveChart.SeriesCollection(1).XValues = XDATA2


Range("C8").Select
Selection.Copy


End If
Next ws
    
End Sub

I'm not very good at VBA, I was only able to put this together using formulas that I've used before and a lot of googleing.
It seems with each sheet it keeps storing more data in the RAM and crashes before the process is complete as I only have 4GB RAM.
Is anyone able to help make this code 'more efficient'? Or is there a way to clear data stored in memory between sheets in the macro?
Please keep in mind im not great at understanding code, so please explain any changes you can make as best you can.
Thanks guys,
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
You don't need all the Select statements. For better efficiency, you can change:

Code:
ActiveSheet.Range("T" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=VLOOKUP(A3, WeekBeginning2013, 2, FALSE)"
Range(Range("T2"), Range("T2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("T2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
to
Code:
Range(Range("T2"), Range("T2").Offset(0, 0).End(xlDown)).formula = "=VLOOKUP(A3, WeekBeginning2013, 2, FALSE)"

Range(Range("T2"), Range("T2").Offset(0, 0).End(xlDown)).Copy 
Range("T2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Hopefully, someone else will comment on the RAM usage.


Tim
 
Last edited:
Upvote 0
Range(Range("AD2"), Range("AD2").Offset(0, 0).End(xlDown)).Select

Anything with End(xlDown) in it is very dangerous = that could be a million rows.
 
Upvote 0
Range(Range("AD2"), Range("AD2").Offset(0, 0).End(xlDown)).Select

Anything with End(xlDown) in it is very dangerous = that could be a million rows.
Yeh I thought that would be the culprit, but as I said my VBA knowledge is limited so this was the only way I knew how to do it.
Any idea for a different function that will select that same range? The furthest amount of rows it would go down would be 50.
 
Upvote 0
Well it appears you have already taken time to find the last row (using the rows.count and end(xlUp) stuff). So just store that info. You put a formula in the next row, so now last row is last row + 1. And you are done ...

In this case, I'll prefer to keep the LastCell (a range object) rather than the Last Row (a number).

Original:
Code:
ActiveSheet.Range("T" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveCell.Formula = "=VLOOKUP(A3, WeekBeginning2013, 2, FALSE)"
Range(Range("T2"), Range("T2").Offset(0, 0).End(xlDown)).Select
    Selection.Copy
    Range("T2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Revised (untested though):
Code:
Dim LastCell As Range '//this goes at the top of your code

    Set LastCell = Range("T" & Rows.Count).End(xlUp)
    LastCell.Offset(1, 0).Formula = "=VLOOKUP(A3, WeekBeginning2013, 2, FALSE)"
    With Range(Range("T2"), LastCell.OffSet(1, 0))
        .Value = .Value
    End With
    Set LastCell = Nothing

Or an alternate version:
Code:
Dim LastCell As Range '//this goes at the top of your code

    Set LastCell = Range("T" & Rows.Count).End(xlUp)
    LastCell.Offset(1, 0).Formula = "=VLOOKUP(A3, WeekBeginning2013, 2, FALSE)"
    With Range("T2:T" & LastCell.Row + 1))
        .Value = .Value
    End With
    Set LastCell = Nothing


I'm not sure how intensive your calcs are or how much data this involves, but it may help to throw a workbook save command in there from time to time, so Excel can write some changes to disk instead of keeping everything in RAM (but I really don't know for sure if that would help). It sounds like it would be wise to make a backup as the first step, in case something goes haywire.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,570
Messages
6,179,610
Members
452,931
Latest member
The Monk

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