I have the following code that does 3 things:

1. in cell F3 it uppers all text and adds the word "cassa" if not already entered;
2. in cell F25 it enters the date and time of the last editing;
3. 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

CodePudding user response：

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