Excel VBA - Run Time Error 7 - Out of memory

k15h4n

New Member
Joined
Apr 4, 2017
Messages
1
Hi,

I keep getting Run Time Error 7 - Out of Memory in the following code:

Code:
Sub PDFandValueVersion()

'   This bit of code will select the worksheets to be PDF'd
    
    
    Dim rng As Range

        For Each rng In Sheets("Config").Range("A1:A" & Sheets("Config").Range("A" & Rows.Count).End(xlUp).Row)
            If UCase(rng.Offset(, 1).Value) = "PDF" Then
            Sheets(rng.Value).Select (False)
            End If
        Next rng
    
    Call PDF

End Sub


Private Sub PDF()

'   This bit of code will save the selected worksheets as a PDF in the defined location in the Config Sheet
    
    
    Dim myDir As String, mySht As String
     
    myDir = Sheets("Config").Range("G24").Value
    mySht = Sheets("Config").Range("G26").Value
     
    On Error Resume Next
    MkDir myDir
    On Error GoTo 0
 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=myDir & "\" & mySht & Format(Now, "yyyy") & "-" & Format(Now, "mm") & "-" & Format(Now, "dd") & ".pdf", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
        
'Reset location
    Worksheets("Config").Select
    
    Call ExcelSave
    
End Sub



Private Sub ExcelSave()

'   This bit of code will save the workbook as the TM version

    
    Dim myDir As String, myFName As String
     
    myDir = Sheets("Config").Range("G20").Value
    myFName = Sheets("Config").Range("G27").Value

    Application.DisplayAlerts = False

    ActiveWorkbook.SaveAs Filename:= _
        myDir & myFName _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

    Application.DisplayAlerts = True
    
    Call Values

End Sub



Private Sub Values()

'   This bit of code will convert all worksheets to values only


    Dim ws As Worksheet
     
    Application.DisplayAlerts = False
     
    For Each ws In Worksheets
        ws.UsedRange = ws.UsedRange.Value
    Next ws
    
    Application.DisplayAlerts = True
    
    Call DeleteFinalSave

End Sub


Private Sub DeleteFinalSave()

'   This bit of code will select all the sheets that are unnecessary for the TM version, delete them and then save as the final TM version


    Dim rng As Range
    
    Application.DisplayAlerts = False

        For Each rng In Sheets("Config").Range("A1:A" & Sheets("Config").Range("A" & Rows.Count).End(xlUp).Row)
            If UCase(rng.Offset(, 2).Value) = "DELETE" Then
            Sheets(rng.Value).Select (False)
            End If
        Next rng
        
    ActiveWindow.SelectedSheets.Delete
    
    Worksheets("Cover Sheet").Select
    
    ActiveWorkbook.Save
    
    Application.DisplayAlerts = True
    
End Sub
When I hit debug the following line of code is highlighted:

Code:
        ws.UsedRange = ws.UsedRange.Value
How would I be able to make this more efficient?

I only need to convert the first 8 odd pages to values, but couldn't code it to work so I went with the approach of converting all worksheets to values.

I don't want to hard code the sheet names into the code as they could change going forward, I have a list of sheet names in a config sheet which I use to reference the worksheets for other parts of the code.

Any help would be much appreciated here.

Thanks
 

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,334
Welcome to the board. I believe it's because the size of the worksheet's used range is too large to fit into memory. You're better of identifying the last used row and last used column then using something like:
Code:
Dim LastRow as Long
Dim LastCol as Long

With WS
   LastRow = .cells(.rows.count, 1).end(xlup).row
   LastCol = .cells(1, .columns.count).end(xltoleft).column
   .cells(1,1).resize(LastRow, LastCol).Value = .cells(1,1).resize(LastRow, LastCol).Value
End With
Above defines the last row found on column A and the last column found on row 1. There is plenty of online help to find the last row and last column when the column and row are not defined or unknown if you need to adjust.
 

Forum statistics

Threads
1,081,545
Messages
5,359,450
Members
400,528
Latest member
Ratish52

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top