Need help optimizing VBA code in Sub WorkSheet_Change - excel

Question

I have the following code that does 3 things:
in cell F3 it uppers all text and adds the word "cassa" if not already entered;
in cell F25 it enters the date and time of the last editing;
in range H5:H12 and D18:K19, if the user deletes the content of the cell, a zero is inserted.
I've noticed that when moving between cells in that sheet there's a slight lag.
I'm sure this code can be optimized to speed it up, but I'm stuck.
Any help would be really appreaciated.
Thank you.
Private Sub WorkSheet_Change(ByVal Target As Range)
Const RNG_TS As String = "F25" 'cella dove mostro "aggiornamento giacenza"
Const rng As String = "F3" 'cella "nome cassa"
Dim stringa As String
Dim TargetDateRange As Range
Set TargetDateRange = Union(Worksheets("GIACENZA MONETE").Range("H5:H12"), Worksheets("GIACENZA MONETE").Range("D18:K19"))
If Target.Cells.CountLarge > 1 Then Exit Sub
If Target.Address = Me.Range(RNG_TS).Address Then Exit Sub 'prevent re-entry
Me.Range(RNG_TS).Value = "Aggiornamento giacenza: " & _
Format(Now(), "dd/mm/yyyy - hh:mm:ss")
If Target.Address = Me.Range(rng).Address Then
stringa = UCase(Trim(Target.Value))
If InStr(1, stringa, "cassa", vbTextCompare) = 0 Then stringa = "CASSA " & stringa
On Error GoTo haveError
Application.EnableEvents = False
Target.Value = stringa
Application.EnableEvents = True
End If
If Not TargetDateRange Is Nothing Then
Application.EnableEvents = False
If ActiveCell.Value = "" Or ActiveCell.Value = vbNullString Or Trim(ActiveCell.Value) = "" Then
ActiveCell.Value = 0
End If
End If
haveError:
Application.EnableEvents = True
End Sub

Answer 1

Private Sub WorkSheet_Change(ByVal Target As Range)
Const RNG_TS As String = "F25" 'cella dove mostro "aggiornamento giacenza"
Const rng As String = "F3" 'cella "nome cassa"
Dim stringa As String
Dim TargetDateRange As Range
Set TargetDateRange = Intersect(Worksheets("GIACENZA MONETE").Range("H5:H12"), Worksheets("GIACENZA MONETE").Range("D18:K19"))
If Target.Cells.CountLarge > 1 Then Exit Sub
Application.EnableEvents = False
If Target.Address = Me.Range(RNG_TS).Address Or Target.Address = Me.Range(rng).Address Then Exit Sub 'prevent re-entry
With Worksheets("GIACENZA MONETE")
Me.Range(RNG_TS).Value = "Aggiornamento giacenza: " & Format(Now(), "dd/mm/yyyy - hh:mm:ss")
If Target.Address = Me.Range(rng).Address Then
stringa = UCase(Trim(Target.Value))
If InStr(1, stringa, "cassa", vbTextCompare) = 0 Then stringa = "CASSA " & stringa
On Error GoTo haveError
Target.Value = stringa
End If
If Not TargetDateRange Is Nothing Then
If Target.Value = "" Or Target.Value = vbNullString Or Trim(Target.Value) = "" Then
Target.Value = 0
End If
End If
End With
Application.EnableEvents = True
End Sub
Maybe this can help