Thread: Slow action in Worksheet_Change

Dear all,

I have the following code in the Private Sub Worksheet_Change(ByVal Target As Range). All work well, but the rounding to 2 decimals places in column C slows down the process. Basically, if I enter an amount, the response is slow and if I delete an amount the cursor and the cell flicker for a few seconds.

Private Sub Worksheet_Change(ByVal Target As Range)

'Force uppercase input
On Error Resume Next

If Not (Application.Intersect(Target, Range("C6:J6")) Is Nothing) Then
    With Target
         If Not .HasFormula Then
            .Value = UCase(.Value)
        End If
    End With
End If

If Not (Application.Intersect(Target, Range("D10:Q300")) Is Nothing) Then
    With Target
         If Not .HasFormula Then
            .Value = UCase(.Value)
        End If
    End With
End If

'Force rounding to 2 decimal places
On Error GoTo ws_exit
Application.EnableEvents = False
    
If Not (Application.Intersect(Target, Range("D10:D300")) Is Nothing) Then
    With Target
        If Not .HasFormula Then
               .Value = Round(.Value, 2)
        End If
        If .Value = 0 Then
               .Value = ""
        End If
    End With
End If

ws_exit:
    Application.EnableEvents = True

' Message if previous row is blank
If Target.Column = 1 Then
    If ActiveCell.Value <> "" And ActiveCell.Offset(-1, 0).Value = "" Then
    MsgBox "La ligne précédente ne doit pas être vide. Veuillez modifier votre saisie s'il vous plait."
    End If
End If

End Sub

Is there any way to avoid this? I had the coding to stop the flickering before but it makes the situation worse.

Application.ScreenUpdating = False

Application.ScreenUpdating = True

Thank you very much for all your help.

Regards,
cdmg

Turning screen updating off should help, switching calculation to manual will probably also make a difference:

Dim myCalc

myCalc = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

' ...your code here

Application.ScreenUpdating = True
Application.Calculation = myCalc

Dom

I can't test this without a sample workbook, but this might be faster

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim icalc As Long

With Application
icalc = .Calculation
.Calculation = xlCalculationManual
'Force uppercase input
On Error Resume Next

If Not (.Intersect(Target, Range("C6:J6")) Is Nothing) Then
    With Target
         If Not .HasFormula Then
            .Value = UCase(.Value)
        End If
    End With
End If
On Error GoTo ws_exit
.EnableEvents = False

If Not (.Intersect(Target, Range("D10:Q300")) Is Nothing) Then
    With Target
         If Not .HasFormula Then
         .Value = Round(.Value, 2)
         .Value = UCase(.Value)
            ElseIf .Value = 0 Then
               .Value = ""
        End If
    End With
End If

ws_exit:
    .EnableEvents = True
    .Calculation = icalc
End With
' Message if previous row is blank
If Target.Column = 1 Then
    If ActiveCell.Value <> "" And ActiveCell.Offset(-1, 0).Value = "" Then _
    MsgBox "La ligne précédente ne doit pas être vide. Veuillez modifier votre saisie s'il vous plait."
End If

End Sub

To best describe or illustrate your problem you would be better off attaching a dummy workbook, the workbook should contain the same structure and some dummy data of the same type as the type you have in your real workbook - so, if a cell contains numbers & letters in this format abc-123 then that should be reflected in the dummy workbook.

If needed supply a before and after sheet in the workbook so the person helping you can see what you are trying to achieve.

Doing this will ensure you get the result you need!

Glad we helped

If you are satisfied with the solution(s) provided, please mark your thread as Solved.

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save