Euro5
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?
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Thanks for the prompt closure of the question, Euro5.
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.