Excel VBA - Run Time Error 7 - Out of memory

[k15h4n]

Hi,

I keep getting Run Time Error 7 - Out of Memory in the following 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:

        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]

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:

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.