excelvba

The VBA code slows down the worksheet needs to be faster


I have a code to add @ symbol between English and Arabic string in the same cell (because I use it in other cells to extract parts of text from this string). For example (NH4-LS-WF-27R-@تم التواصل بالعميل )it works good and runs automatically upon adding data in cell "E" but unfortunately it takes almost 2-3 seconds freezing the sheet to apply the matter which force me to wait every time at every single row while adding data to my sheet - any suggestions please to make it faster here is my code

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("E10:E1500")) Is Nothing Then

    Dim L, count As Long, B, E As Range
    For R = 1 To ActiveSheet.Cells(ActiveSheet.Rows.count, "E").End(xlUp).Row
        Set B = ActiveSheet.Range("B" & R)
        Set E = ActiveSheet.Range("E" & R)
        If E.Value <> "" And B.Value <> "" And IsNumeric(B.Value) Then
            If InStr(E.Text, "@") < 1 Then
                count = 0
                For L = 1 To Len(E.Text)
                    If AscW(Mid(E.Text, L, 1)) < 1000 Then count = count + 1 Else Exit For
                Next
                
                E.Value = Left(E.Value, count) & "@" & Right(E.Value, Len(E.Value) - count)
                                                                           
            End If
        End If
    Next
                     
        ThisWorkbook.Save

End If
End Sub

Solution

  • 1) Ensure that your code runs only on the modified cell(s). The parameter Target tells you which cell(s) where modified, so apply the code only on this cells. As you are only interested in cells of column E, add a check.

    Dim cell As Range
    For Each cell In Target
        If cell.Column = 5 Then
            ... Here we have to do something.
        End If
    Next cell
    

    2) Put the logic to add the '@' into the string in a function to clean up your code. You can put the function into the worksheet module, however, I would advice to use a regular module.

    Function SeparateContent(s As String) As String
        Const Delimiter As String = "@"
    
        ' Delimiter already present
        If InStr(s, Delimiter) > 0 Then
            SeparateContent = s
            Exit Function
        End If
        
        ' Find place for delimiter
        Dim i As Long
        For i = 1 To Len(s)
            If AscW(Mid(s, i, 1)) > 1000 Then
                SeparateContent = Left(s, i - 1) & Delimiter & Mid(s, i)
                Exit Function
            End If
        Next i
        
        ' No delimiter needed
        SeparateContent = s
    End Function
    

    Call this function from your event routine:

    cell.Value = SeparateContent(cell.Value)
    

    3) You are changing the content of a cell in the event handler. That again will call the event handler, and that can cause and endless loop (which can result in an "Stack overflow" error. To prevent that, disable event triggering while your code runs using Application.EnableEvents = False. Don't forget to enable the events at the end of the code. Use error handling to ensure that the events are enabled again even in case of an runtime error

    Private Sub Worksheet_Change(ByVal Target As Range)
    
        Dim cell As Range
        On Error Goto Change_Exit
        Application.EnableEvents = False
        For Each cell In Target
            If cell.Column = 5 Then
                cell.Value = SeparateContent(cell.Value)
            End If
        Next cell
    Change_Exit:
        Application.EnableEvents = True
    End Sub
    

    4) Don't save your workbook after a change - this will naturally slow down your code. It's up to the user to decide when to save (or use the AutoSave feature).

    5) (Just as side note). In your code, you have the following variable declaration:

    Dim L, count As Long, B, E As Range
    

    In VBA, this will declare the variable count as Long and E as Range, but L and B will be of type Variant. You need to specify the type for every variable:

    Dim L As Long, count As Long, B As Range, E As Range