adding a sheet causing an "Out of Memory" error

0

I want to add a simple line of VBA code to add a sheet in the usertemp workbook

Sub Find_Cost_Centers()
'   Todays_Date Macro
'
    ActiveCell.FormulaR1C1 = "=TODAY()"
    Selection.NumberFormat = "m/d/yyyy"
    ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
' Count_Cost_Centers Macro
'
'
    ActiveCell.Name = "Cost_Center_Name"
    ActiveWorkbook.Names("Cost_Center_Name").Comment = ""
    Windows("CostCentertemp.xls").Activate
    'Find the last used row in a Column: column A in this example
    Dim LastRow As Integer
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastRow = LastRow - 1
    End With
'    MsgBox LastRow
    Windows("User File Analysis test.xlsm").Activate
    Range("Cost_Center_Name").Select
    ActiveCell.Value = LastRow
    ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
    ActiveCell.FormulaR1C1 = "=if(r[0]c[-1]-r[-1]c[-1]<0,r[0]c[-1]-r[-1]c[-1]&"" less"",if(r[0]c[-1]-r[-1]c[-1]>0,r[0]c[-1]-r[-1]c[-1]&"" more"",if(r[0]c[-1]-r[-1]c[-1]=0,"" same as last week"")))"
    ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
' Count Divisions
    ActiveCell.Name = "Divisions"
    ActiveWorkbook.Names("Cost_Center_Name").Comment = ""
    Windows("Divisiontemp.xls").Activate
    'Find the last used row in a Column: column A in this example
    Dim DivLastRow As Integer
    With ActiveSheet
        DivLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        DivLastRow = DivLastRow - 1
    End With
'    MsgBox LastRow
    Windows("User File Analysis test.xlsm").Activate
    Range("Divisions").Select
    ActiveCell.Value = DivLastRow
    ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
    ActiveCell.FormulaR1C1 = "=if(r[0]c[-1]-r[-1]c[-1]<0,r[0]c[-1]-r[-1]c[-1]&"" less"",if(r[0]c[-1]-r[-1]c[-1]>0,r[0]c[-1]-r[-1]c[-1]&"" more"",if(r[0]c[-1]-r[-1]c[-1]=0,"" same as last week"")))"
    ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
    ActiveCell.Name = "Users"
' extract_users Macro
'
'
    Windows("usertemp.xls").Activate
    Sheets("Excel_Destination").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AO$31171").AutoFilter Field:=3, Criteria1:="true"
    Cells.Select
    Selection.Copy
 code to add sheet goes here but I can't do it withouot getting an out of memory error  
    Sheets("Sheet1").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  
'Count users
    Windows("usertemp.xls").Activate
    Sheets("Sheet1").Select
    Dim Countusers As Integer
    Countusers = Application.CountA(Range("b:b"))
    Windows("User File Analysis test.xlsm").Activate
    Range("Users").Select
    ActiveCell.Value = Countusers
    ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
    ActiveCell.FormulaR1C1 = "=if(r[0]c[-1]-r[-1]c[-1]<0,r[0]c[-1]-r[-1]c[-1]&"" less"",if(r[0]c[-1]-r[-1]c[-1]>0,r[0]c[-1]-r[-1]c[-1]&"" more"",if(r[0]c[-1]-r[-1]c[-1]=0,"" same as last week"")))"
'   Count Wands
    Windows("usertemp.xls").Activate
    Dim wands As Integer
    wands = Application.CountIf(Range("b:b"), "WAND*")
'    MsgBox wands
'
'   Count Sanofi Pasteur
    Dim sp As Integer
    sp = Application.CountIf(Range("af:af"), "1038") + Application.CountIf(Range("af:af"), "2605") + Application.CountIf(Range("af:af"), "3600") + Application.CountIf(Range("af:af"), "9583") + Application.CountIf(Range("af:af"), "99901")
'
'   Count Sanofi aventis
    Dim sa As Integer
    sa = Application.CountIf(Range("af:af"), "207") + Application.CountIf(Range("af:af"), "400") + Application.CountIf(Range("af:af"), "698") + Application.CountIf(Range("af:af"), "2125") + Application.CountIf(Range("af:af"), "5312") + Application.CountIf(Range("af:af"), "9000") + Application.CountIf(Range("af:af"), "99902")
'
'   Count Genzyme
    Dim gz As Integer
    gz = Application.CountIf(Range("af:af"), "5100") + Application.CountIf(Range("af:af"), "5102") + Application.CountIf(Range("af:af"), "99903")
'
'   Count Chattem
    Dim ch As Integer
    ch = Application.CountIf(Range("af:af"), "99905")
'
'   Put counts in Analysis worksheet
    Windows("User File Analysis test.xlsm").Activate
    Sheets("Sheet1").Select
    Range("Users").Select
    ActiveCell.Offset(rowOffset:=0, columnOffset:=2).Activate
    ActiveCell = "WANDS =" & wands & " / " & "SP = " & sp & " / " & "SA = " & sa & " / " & "GZ = " & gz & " / " & "CH = " & ch
    ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
    ActiveCell.Name = "BogusUsrId"
 End Sub

   It's not a big spreadsheet, it's not a big macro, nor is it really complicated.   Can't figure out why it is giviing me the error.

Answer
Discuss

Discussion

I've edited the post to include the entire macro. 
aoswald Mar 9, '17 at 7:38 am
Answer updated.
don (rep: 1492) Mar 9, '17 at 8:11 am
I saved the macro in  a different worksheet and was able to add the line of code and run the macro with no issues.  Still not sure why it was giving me a problem but I can live with this solution. 
aoswald Mar 9, '17 at 8:26 am
It must have had to do with the data in the original worksheet and the copy/paste lines. If you run into that issue again, try my suggestion and see if it helps.
don (rep: 1492) Mar 9, '17 at 8:31 am
Add to Discussion

Answers

0

I have no problems running the macro. You could simply be running out of memory due to other programs on your computer or you have too many sheets in the workbook.

Try running this single line of code on a new workbook without anything else open and see if it works for you then.

Otherwise, maybe the full macro, and not just this line of code is causing the issue; if you edit your question and include the full macro, I can take a look at it.

Update:

It looks like these lines might be causing the problem:

ActiveSheet.Range("$A$1:$AO$31171").AutoFilter Field:=3, Criteria1:="true"
Cells.Select
Selection.Copy

Here, you are copying A LOT of data to memory.

Take these lines out and re-insert the add sheet code and see if it runs OK; if it does, that means that this was the cause of the issue.

If these lines are the issue, I would try to copy/paste this data in chunks instead of all at once, maybe 1 column at a time until it's finished copying.

Discuss

Answer the Question

You must create an account to use the forum. Create an Account or Login