I am using VBA to find and replace currency formats across all worksheets based on currency selection in a particular cell. The code works just fine functionally, but I often run into an error - "There is not enough memory to complete this operation. Try using less data or closing other applications."
I am new to VBA and I believe this is because my code isn't optimal in its usage of memory. Below is the code for the whole function. The boded area is where the VBA stops executing and throws the memory error. I will be very thankful for a solution!
I have also attached a sample workbook with the current code and the objective explained within.
View attachment SampleCurrConvert.xlsm
Please note that while this sample workbook only handles 2 currencies in 2 worksheets, I need this code to optimally work over 5 data-intensive tabs with 10+ currencies
Problem - In the actual workbook, I often run into a memory error as described previously.
Request Assistance in - Please help me optimize the code in this attached example workbook to utilize less memory so that the memory error does not show up in my actual workbook.
I am new to VBA and I believe this is because my code isn't optimal in its usage of memory. Below is the code for the whole function. The boded area is where the VBA stops executing and throws the memory error. I will be very thankful for a solution!
I have also attached a sample workbook with the current code and the objective explained within.
View attachment SampleCurrConvert.xlsm
Please note that while this sample workbook only handles 2 currencies in 2 worksheets, I need this code to optimally work over 5 data-intensive tabs with 10+ currencies
Problem - In the actual workbook, I often run into a memory error as described previously.
Request Assistance in - Please help me optimize the code in this attached example workbook to utilize less memory so that the memory error does not show up in my actual workbook.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("C1").Address Then
Dim theSheet As Worksheet, c As Range, r As Range, i As Integer, n As Name, o As Name
Set n = ActiveWorkbook.Names("FromFormats")
Set o = ActiveWorkbook.Names("ToFormats")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each theSheet In ActiveWorkbook.Sheets
If Not (theSheet.Name = "Tab3") Then
'Loop through all used cells in the workbook and if they contain a currency value, then multiply by the target currency exchange rate
For Each c In theSheet.UsedRange
If Not (c.HasFormula) And Not (Application.IsText(c)) And Not (IsEmpty(c)) Then
For Each r In n.RefersToRange
If c.NumberFormat = r.Value Then c.Value = c.Value * Range("ConversionFactor").Value
Next r
End If
Next c
For i = 1 To n.RefersToRange.Rows.Count
'For every cell in the workbook that contains a currency value formatted in the old currency (fromcurrency), replace the format of that cell with the
'format of the new currency
With Application
.FindFormat.Clear
.ReplaceFormat.Clear
.FindFormat.NumberFormat = n.RefersToRange.Cells(i).Value
.ReplaceFormat.NumberFormat = o.RefersToRange.Cells(i).Value
End With
theSheet.Cells.Replace What:=vbNullString, Replacement:=vbNullString, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
Next i
End If
Next theSheet
With Application
.FindFormat.Clear
.ReplaceFormat.Clear
.ScreenUpdating = True
End With
Application.Calculation = xlCalculationAutomatic
End If
End Sub
