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
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