I have couple worksheets where I am using a macro to do some calculations. This calculation is supposed to run if any cell in the range is changed.
Below is the code that runs.
Private Sub Worksheet_Change(ByVal Target As Range)
' Check if change is made to the correct range of cells.
Dim Results As Variant
'Defaults while sheet only used in Rotterdam
mGravityUnit = UnitDensity
mVolumeUnit = UnitCubicMetres
mTempUnit = UnitCelcius
With Application
If Not (.Intersect(Target, Range("Grade1ROBTemp")) Is Nothing And .Intersect(Target, Range("Grade1ROBDensity")) Is Nothing And .Intersect(Target, Range("Grade1ROBVCF")) Is Nothing And .Intersect(Target, Range("Grade2ROBTemp")) Is Nothing And .Intersect(Target, Range("Grade2ROBDensity")) Is Nothing And .Intersect(Target, Range("Grade2ROBVCF")) Is Nothing And .Intersect(Target, Range("Grade3ROBTemp")) Is Nothing And .Intersect(Target, Range("Grade3ROBDensity")) Is Nothing And .Intersect(Target, Range("Grade3ROBVCF")) Is Nothing) Then
' Change in Volume Temp or Density
Dim ThisRow As Integer, VCF As Double
ThisRow = Target.Row
If Not (Cells(ThisRow, 8) = "" Or Cells(ThisRow, 9) = "") Then
WaitFor (0.05)
Results = VCF_Calculation(Cells(ThisRow, 8), mTempUnit, Cells(ThisRow, 9), mGravityUnit, mVolumeUnit)
Cells(ThisRow, 10) = Results
Else
Cells(ThisRow, 10) = ""
End If
End If
End With
End Sub
This code works fine in one worksheet, running only for the rows that have changes.
But in the other sheet, this same code runs for all the rows in the range, instead of the one row where the cell was changed. Because of this, macro fails to run properly, as it is taking more time than required to work.
Clearly, I am supposed to set some property in excel range that will cause the macro to run only for the updated row, and not for all the rows.
Edit: I guess I defined ranges wrong, that's why it was triggering the change event again and again.
Disabling events fixed the problem. Thanks everyone.
Start by adding Application.EnableEvents = False just after intersect then Application.EnableEvents = True before exiting the sub. Failing to add this crucial code will have the sub try to run on top of itself as soon as you change a value on the worksheet.
Use the Union method to stitch all of your named ranges together.
Don't even dim vars before you know you are going to need them.
Private Sub Worksheet_Change(ByVal Target As Range)
'only process if we are dealing with a single Target
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Union(Range("Grade1ROBTemp"), Range("Grade1ROBDensity"), _
Range("Grade1ROBVCF"), Range("Grade2ROBTemp"), Range("Grade2ROBDensity"), Range("Grade2ROBVCF"), _
Range("Grade3ROBTemp"), Range("Grade3ROBDensity"), Range("Grade3ROBVCF"))) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
'Defaults while sheet only used in Rotterdam
mGravityUnit = UnitDensity
mVolumeUnit = UnitCubicMetres
mTempUnit = UnitCelcius
' Change in Volume Temp or Density
Dim ThisRow As Long, VCF As Double, Results As Variant
ThisRow = Target.Row
If CBool(Len(Cells(ThisRow, 8))) And CBool(Len(Cells(ThisRow, 9))) Then
WaitFor (0.05)
Results = VCF_Calculation(Cells(ThisRow, 8), mTempUnit, Cells(ThisRow, 9), mGravityUnit, mVolumeUnit)
Cells(ThisRow, 10) = Results
Else
Cells(ThisRow, 10) = ""
End If
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
Only process your code if a single call is the Target. If more than a single cell has changed then the above code won't work. You will have to use something like For Each rng in INtersect(....
Collected from the Internet
Please contact [email protected] to delete if infringement.
Comments