iCell Value takes too long

Question

I have some straightforward code that iterates over 400 rows. It functions but takes 30 seconds. The iCell is the source of the issue.

stringaDescriptata line value

Can the code be made to run more quickly?

Sub Decr()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim counter As Integer
Dim stringaCriptata As String
Dim stringaDecriptata As String
Dim carattere_da_decriptare As String
Dim carattere_da_sostituire As String
Dim iCell As Range

For Each iCell In Range("A1:BK460")
    stringaDecriptata = ""
    lunghezza = Len(iCell.Value)
    indirizzo = iCell.Address
    
    For counter = 1 To lunghezza
        stringaCriptata = iCell.Value
        carattere_da_decriptare = Mid(iCell.Value, counter, 1)
        carattere_da_sostituire = Chr(Asc(carattere_da_decriptare) - 10)
        
        stringaDecriptata = stringaDecriptata & carattere_da_sostituire
    Next
    
    iCell.Value = stringaDecriptata
Next iCell

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Answer 1

Please try the following modified code. The range that needs to be processed is put into an array, and everything is done in memory. Only at the end of the code does it immediately drop the processed result:

Sub Decr()
 Dim sh As Worksheet, i As Long, j As Long, rng As Range, arr As Variant, counter As Integer
 Dim stringaCriptata As String, stringaDecriptata As String, carattere_da_decriptare As String
 Dim carattere_da_sostituire As String, lunghezza As Long

 Set sh = ActiveSheet
 Set rng = sh.Range("A1:BK460")
 arr = rng.Value2  'place the range in an array for faster processing

 For i = 1 To UBound(arr)        'iterate between the array rows
    For j = 1 To UBound(arr, 2)  'iterate between the array columns
         stringaDecriptata = ""
         lunghezza = Len(arr(i, j))
         For counter = 1 To lunghezza
            stringaCriptata = arr(i, j)
            carattere_da_decriptare = Mid(arr(i, j), counter, 1)
            carattere_da_sostituire = Chr(Asc(carattere_da_decriptare) - 10)
            
            stringaDecriptata = stringaDecriptata & carattere_da_sostituire
        Next counter
        arr(i, j) = stringaDecriptata 'place the decrypted string back in the array element
    Next j
 Next i

 'drop the processed array result, at once:
 rng.Value2 = arr
End Sub

It takes time to iterate through each range cell, and it takes considerably longer to put back each processed value individually.

Then, it is wise to develop the practice of declaring all relevant variables. Option Explicit should be placed on top of the module in order to allow VBA to assist you if you forget it.