VBA Run-time Error 7 Out of Memory

Question

this might be on here somewhere and I missed it, just let me know.

After running my macro, I get Run-time Error 7 Out of Memory. After debugging, it's on this line:

cell.Offset(0, 6).Value = Sheets("MakeRing_Maths").Range("N1").Value

The code is meant to run down a list of airports with longitudes and latitudes, create line segments that will be interpreted as circles, and convert to .KML (which is read by Google Earth Pro).

Here is the rest of the code - how can I clean something like this up to avoid memory leaks??

All answers appreciated, or pointers to other posts. I know this is a lot, so general suggestions are also welcome! Thank you!

Sub PLANEMAN_Coords()

Dim Latitude As Double
Dim Longitude As Double
Dim Bearing As Integer
Dim LeftRight As Integer
Dim RangeKM As Double
Dim MinRange As Double

For Each cell In [RangeRings_ENTER!B9:B5001]

    If cell.Value = "" Then
        GoTo EXITLOOP
    Else
    End If

    Latitude = cell.Offset(0, 1)
    Longitude = cell.Value

    'set default values:

    'line width
    If cell.Offset(0, 2).Text = "" Then
        cell.Offset(0, 2).Value = 2
        'default line width = 2
    Else
    End If

    'radius
    If cell.Offset(0, 5).Text = "" Then
       cell.Offset(0, 5).Value = 8.04672
        'default radius = 8.04672 km = 5 miles
    Else
    End If
    RangeKM = cell.Offset(0, 5)

    'line color
    If cell.Offset(0, 3).Text = "" Then
        cell.Offset(0, 3).Value = "ff0000ff"
        'default line color is Red
    Else
    End If

    'common code
    Sheets("MakeRing_Maths").Range("D3").Value = Longitude
    Sheets("MakeRing_Maths").Range("E3").Value = Latitude
    Sheets("MakeRing_Maths").Range("D1").Value = RangeKM

    'code that differs depending on range-ring type
    If cell.Offset(0, 7).Text = "Circle" Then
        Sheets("MakeRing_Maths").Range("J1").Value = 0 'Bearing
        Sheets("MakeRing_Maths").Range("J2").Value = 180 'width - ie 2 x 180 = 360 = complete circle
        Calculate
        cell.Offset(0, 6).Select 'just so that the user can 'see' that the macro is still running and not crashed
        cell.Offset(0, 6).Value = Sheets("MakeRing_Maths").Range("N1").Value
    Else
        'else wedge of some sort

        Bearing = cell.Offset(0, 8)
        LeftRight = cell.Offset(0, 9)
        MinRange = cell.Offset(0, 10)

        Sheets("MakeRing_Maths").Range("J1").Value = Bearing
        Sheets("MakeRing_Maths").Range("J2").Value = LeftRight

        If cell.Offset(0, 7).Text = "Wedge" Then
            Calculate
            cell.Offset(0, 6).Select 'just so that the user can 'see' that the macro is still running and not crashed
            cell.Offset(0, 6).Value = Sheets("MakeRing_Maths").Range("N2").Value
        Else 'else a wedge with minimum range component 'Wedge2
            If cell.Offset(0, 7).Text = "Wedge2" Then
                Sheets("MakeRing_Maths").Range("F1").Value = MinRange
                Calculate
                cell.Offset(0, 6).Select 'just so that the user can 'see' that the macro is still running and not crashed
                cell.Offset(0, 6).Value = Sheets("MakeRing_Maths").Range("N3").Value
            Else
                If cell.Offset(0, 7).Text = "Arrow" Then
                    Sheets("MakeRing_Maths").Range("F1").Value = RangeKM * 0.95
                    Calculate
                    cell.Offset(0, 6).Select 'just so that the user can 'see' that the macro is still running and not crashed
                    cell.Offset(0, 6).Value = Sheets("MakeRing_Maths").Range("N4").Value
                Else
                    'HERE
                End If
            End If
        End If
    End If
Next

EXITLOOP:

Call PLANEMAN_RangeRings_KML 'make KML file

End Sub



Sub PLANEMAN_RangeRings_KML()
' Original inspiration code by simon_a
' Planeman 2009

    'get user to specify save location and name
    Dim ThisAddress As String
    ChDir ThisWorkbook.Path
    ThisAddress = Application.GetSaveAsFilename(FileFilter:="KML Files (*.kml),*.kml", Title:="Save Location & Name")

    ' file details
    filePath = ThisAddress
    docName = "PLANEMAN.KML"
    FolderName = "Folder"

    Open filePath For Output As #1

    'Write header to file
    outputText = "<?xml version=""1.0"" encoding=""UTF-8""?> <kml xmlns=""http://www.opengis.net/kml/2.2"" xmlns:gx=""http://www.google.com/kml/ext/2.2"" xmlns:kml=""http://www.opengis.net/kml/2.2"" xmlns:atom=""http://www.w3.org/2005/Atom""> <Document><name>" & docName & "</name>    <Folder>    <name>" & FolderName & "</name>  <open>1</open>"
    Print #1, outputText

    'loop
    For Each cell In [RangeRings_ENTER!B9:B5001]

        If cell.Value = "" Then
           Exit For
        End If

        StrPart1 = "<Style id=""sn_ylw-pushpin""><IconStyle><color>" & cell.Offset(0, 3) & "</color></IconStyle><LineStyle><width>" & cell.Offset(0, 2) & "</width><color>" & cell.Offset(0, 3) & "</color></LineStyle><PolyStyle><color>" & cell.Offset(0, 3) & "</color></PolyStyle></Style>"
        StrPart2 = "<Placemark><name>" & cell.Offset(0, -1) & "</name>  <styleUrl>#sn_ylw-pushpin</styleUrl>    <LineString>    "
        StrPart3 = "<coordinates>" & cell.Offset(0, 6) & ",0 </coordinates> </LineString></Placemark>"

        'Create a placemark
        outputText = StrPart1 & StrPart2 & StrPart3
        Print #1, outputText

    Next

   'Write footer to file
    outputText = "</Folder></Document></kml>"
    Print #1, outputText

    Close #1

    MsgBox "Macro Complete"

'
End Sub

Sub PLANEMAN_Placemarks_KML()
' Original inspiration code by simon_a
' Planeman 2009

    'get user to specify save location and name
    Dim ThisAddress As String
    ChDir ThisWorkbook.Path
    ThisAddress = Application.GetSaveAsFilename(FileFilter:="KML Files (*.kml),*.kml", Title:="Save Location & Name")

    ' file details
    filePath = ThisAddress
    docName = "PLANEMAN.KML"
    FolderName = "PlacemarkFolder"

    Open filePath For Output As #1

    'Write header to file
    outputText = "<?xml version=""1.0"" encoding=""UTF-8""?><kml xmlns=""http://www.opengis.net/kml/2.2""> <Document><name>" & docName & "</name>    <Folder>    <name>" & FolderName & "</name>  <open>1</open>"
    Print #1, outputText

    'loop
    For Each cell In [Placemarks_ENTER!B9:B5001]

        If cell.Value = "" Then
           Exit For
        End If

        StrPart1 = ""
        StrPart2 = " <Placemark> <name> " & cell.Offset(0, -1) & " </name> "
        StrPart3 = cell.Offset(0, 6) & "<Point><coordinates> " & cell.Offset(0, 0) & "," & cell.Offset(0, 1) & ",0</coordinates> </Point> </Placemark>"

        'Create a placemark
        outputText = StrPart1 & StrPart2 & StrPart3
        Print #1, outputText

    Next

   'Write footer to file
    outputText = "</Folder></Document></kml>"
    Print #1, outputText

    Close #1

    MsgBox "Macro Complete"

'
End Sub

Answer 1

Thank you so much for your answers, I found the solution!

Turns out an easy fix was to truncate some numbers as they were very large (15+ decimal digits), and now it pumps through like a charm.

Thank you for your time!

UPATE:

Always make it a point to add Option Explicit in your code and declare your variables explicitly. You can follow these steps to configure, so the editor adds this line automatically. In this manner, you are aware and able to manage the variables, handle datatypes with respect to their memory allocations.

a. In the Visual Basic Editor, click on Tools and then click on Options.

b. Check Require Variable Declaration.

It would have been pretty nice for VBA compiler to through a bit more expressive error message (e.g. value too large) instead of plain old general out of memory for cases like this. Anyway following is the link explaining possible reasons causing this error.

More memory was required than is available, or a 64K segment boundary was encountered. This error has the following causes and solutions:

You have too many applications, documents, or source files open. Close any unnecessary applications, documents, or source files that are open.

You have a module or procedure that's too large.

Break large modules or procedures into smaller ones. This doesn't save memory, but it can prevent hitting 64K segment boundaries.

You are running Microsoft Windows in standard mode. Restart Microsoft Windows in enhanced mode.

You are running Microsoft Windows in enhanced mode, but have run out of virtual memory. Increase virtual memory by freeing some disk space, or at least ensure that some space is available.

You have terminate-and-stay-resident programs running. Eliminate terminate-and-stay-resident programs.

You have many device drivers loaded. Eliminate unnecessary device drivers.

You have run out of space for Publicvariables

Reduce the number of Public variables.

(1) Excel specifications and limits.

(2) Numeric precision in Microsoft Excel.

Accuracy within VBA Although Excel nominally works with 8-byte numbers by default, VBA has a variety of data types. The Double data type is 8 bytes, the Integer data type is 2 bytes, and the general purpose 16 byte Variant data type can be converted to a 12 byte Decimal data type using the VBA conversion function CDec.[16] Choice of variable types in a VBA calculation involves consideration of storage requirements, accuracy and speed.

(3) If you are using credit card numbers, or other number codes that contain 16 digits or more, you must use a text format because Excel has a maximum of 15 digits of precision and will round any numbers that follow the 15th digit down to zero.