Link to home
Start Free TrialLog in
Avatar of Euro5
Euro5Flag for United States of America

asked on

VBA replace code uses too much memory

The following replace code takes all my memory when it is runs and requires me to restart.
Is there any other method to improve on memory and speed?


Sub Zone_Change()
Dim rngData As Variant
Dim lngLastEntry As Long
Dim lngEntry As Long
Const COL_F = 6
Const COL_Q = 17
Const COL_AG = 33
Const COL_AM = 39
Const COL_BD = 56
Dim lrow As Long


Application.Calculation = xlCalculationManual
With ActiveSheet

lrow = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    ' Copy the cell values (ignoring the headers) from columns A to BD to an array
    rngData = .Range("F2:BD" & lrow).Value
    ' Determine the last row in the array
    lngLastEntry = UBound(rngData)
    ' Loop through the array
    For lngEntry = 1 To lngLastEntry
        Select Case UCase(rngData(lngEntry, COL_F))
            Case "IE", "IP", "IPF", "IEF"
                 ' If Shipper Country is "US" and Recipient Country Code is not "US"
                If rngData(lngEntry, COL_Q) = "US" And rngData(lngEntry, COL_AG) <> "US" Then
                    ' Change the value in array column 56 (sheet column BD)
                    ' if array column 39 (sheet column AM) contains certain values
                    Select Case rngData(lngEntry, COL_AM)
                        Case "A"
                            rngData(lngEntry, COL_BD) = 2
                        Case "B"
                            rngData(lngEntry, COL_BD) = 3
                        Case "C"
                            rngData(lngEntry, COL_BD) = 4
                        Case "D"
                            rngData(lngEntry, COL_BD) = 5
                        Case "E"
                            rngData(lngEntry, COL_BD) = 6
                        Case "F"
                            rngData(lngEntry, COL_BD) = 7
                        Case "G"
                            rngData(lngEntry, COL_BD) = 8
                        Case "H"
                            rngData(lngEntry, COL_BD) = 9
                        Case "lngEntry"
                            rngData(lngEntry, COL_BD) = 10
                        Case "J"
                            rngData(lngEntry, COL_BD) = 11
                        Case "K"
                            rngData(lngEntry, COL_BD) = 12
                        Case "L"
                            rngData(lngEntry, COL_BD) = 13
                        Case "M"
                            rngData(lngEntry, COL_BD) = 14
                        Case "N"
                            rngData(lngEntry, COL_BD) = 15
                        Case "O"
                            rngData(lngEntry, COL_BD) = 16
                    End Select
                 ' If Shipper Country is not "US" and Recipient Country Code is "US"
                ElseIf rngData(lngEntry, COL_Q) <> "US" And rngData(lngEntry, COL_AG) = "US" Then
                    Select Case rngData(lngEntry, COL_AM)
                        Case "A"
                            rngData(lngEntry, COL_BD) = 2
                        Case "C"
                            rngData(lngEntry, COL_BD) = 3
                        Case "D"
                            rngData(lngEntry, COL_BD) = 4
                        Case "E"
                            rngData(lngEntry, COL_BD) = 5
                        Case "F"
                            rngData(lngEntry, COL_BD) = 6
                        Case "G"
                            rngData(lngEntry, COL_BD) = 7
                        Case "H"
                            rngData(lngEntry, COL_BD) = 8
                        Case "I"
                            rngData(lngEntry, COL_BD) = 9
                        Case "J"
                            rngData(lngEntry, COL_BD) = 10
                        Case "K"
                            rngData(lngEntry, COL_BD) = 11
                        Case "L"
                            rngData(lngEntry, COL_BD) = 12
                        Case "M"
                            rngData(lngEntry, COL_BD) = 13
                        Case "N"
                            rngData(lngEntry, COL_BD) = 14
                        Case "O"
                            rngData(lngEntry, COL_BD) = 15
                        Case "P"
                            rngData(lngEntry, COL_BD) = 16
                    End Select
                End If
            End Select
        Next
        ' Copy the array data back to the sheet
        .Range("F2:BD" & .UsedRange.Rows.Count).Value = rngData
    End With
   Application.Calculation = xlCalculationAutomatic
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of [ fanpages ]
[ fanpages ]

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
The purpose of a variant range like rngData is to allow the copying of the data to an array so that in can be modified there rather than in the sheet itself. Doing it via the variant array (and keeping in mind the fact that the array can be written back to the sheet with one statement) is a lot faster but as you found out you pay the price with memory usage. Considering that you have a lot columns and over 90,000 rows you will need a lot of memory.

It's possible that you are running out of memory because when you use statements like Set wb1 = ActiveWorkbook you are creating objects that are supposed to be eliminated by Excel once you leave the scope of the sub that contains the statement, but you might try doing a Set wb1 = Nothing (or whatever else is "Set") at the end of each sub and see if that helps.
Avatar of [ fanpages ]
[ fanpages ]

Thanks for the prompt closure of the question, Euro5.