Simple Excel VBA takes ages

Question

I have written a simple VBA script (code below) that should inspect every cell in a certain column. Here I want to do some string manipulation ( i wante to search for "." in the string and then take the right side, but because I could not get it to work I always take the 4 digit as a start). I then copy the manipulated string into another cell and later back. The code works, but for some reason, it takes ages to run on only 35 cells!

I´m still a kook on VBA and wanted to get input what could be the reason for it and what I could improve to get a faster runtime. Is it because I take all strings froms 4 up to 50 ?

Sub EditStatus()
    Application.DisplayAlerts = False
    ActiveSheet.Name = "Backend"
    myNum = Application.InputBox("Please enter the row number until which you would like to update the status column (only for new entries)")
        For i = 2 To myNum
            Cells(i, 20).Value = Mid(Cells(i, 10), 4, 50)
            Cells(i, 10).Value = Cells(i, 20).Value
        Next i
    Range("T1:T200").Clear
    Application.DisplayAlerts = True
End Sub

Thanks

How big is `myNum` likely to be? Do you have other code in the file? — SJR, Jan 29 '21 at 10:42
That code runs semi-instantaneously for me on 500 rows with an initial 200 character string in the cell being tested. It shouldn't make much of a difference, but what are the values in the cells you are checking? What you should always do, though is to declare your variables and use the `Option Explicit` statement... — Morten, Jan 29 '21 at 10:48
If you have a lot of formulas (especially if they are volatile) it will calculate them after every cell change. Make sure you turn off calculation `Application.Calculation` before running it and turn it on after. • The code is actually pretty fast. — Pᴇʜ, Jan 29 '21 at 10:49

Siddharth Rout · Answer 1 · 2021-01-29T13:55:56.103

3

No need for a loop. You can enter the formula in the entire range in 1 go and then convert them to values before putting the values back in Col J

Replace

For i = 2 To myNum
    Cells(i, 20).Value = Mid(Cells(i, 10), 4, 50)
    Cells(i, 10).Value = Cells(i, 20).Value
Next i

With

With Range("T2:T" & myNum)
    .Formula = "=MID(J2, 4, 50)"
    .Value = .Value
    Range("J2:J" & myNum).Value = .Value
End With

Alternatively, you can directly perform the same action in Col J without the helper column T. For example you can do all that in 1 line as explained HERE as well

Simply replace

For i = 2 To myNum
    Cells(i, 20).Value = Mid(Cells(i, 10), 4, 50)
    Cells(i, 10).Value = Cells(i, 20).Value
Next i
Range("T1:T200").Clear

with

 Range("J2:J" & myNum).Value = Evaluate("Index(MID(" & "J2:J" & myNum & ", 4, 50),)")

edited Jan 29 '21 at 13:55

answered Jan 29 '21 at 10:50

Siddharth Rout

147,039
17
206
250

1

Thanks for you help! Unfortunatly in your solution there is one Error, I think! Because in each row can be a different text e.g Row 1: 5.Shortlisted Row 2: 4.Longlisted etc. in your solution every row would have the entry from row 1. Right ? – David Pfurtscheller Jan 29 '21 at 13:00
Sincere apologies. Yes you are right.. a minor change was needed. I have updated it :) You may have to refresh the page to see it. – Siddharth Rout Jan 29 '21 at 13:56

VBasic2008 · Answer 2 · 2021-01-29T14:19:07.980

Replace Values In-Place

Adjust the values in the constants section.
This solution overwrites the data and doesn't use a helper column, but you can test it with one indicated near the end of the code.
Solve the renaming (Backend) part as needed.

The Code

Option Explicit

Sub EditStatus()
    
    ' Define constants.
    Const sPrompt As String = "Please enter the row number until which you " _
        & "would like to update the status column (only for new entries)"
    Const sTitle As String = "Enter Number"
    Const wsName As String = "Backend"
    Const First As Long = 2
    Const cCol As Long = 10 ' J
    Const Delim As String = "."
    
    ' Define workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' Workbook containing this code.
    
    ' Require input.
    Dim Last As Variant
    Last = Application.InputBox( _
        Prompt:=sPrompt, Title:=sTitle, Default:=First, Type:=1)
    
    ' Validate input.
    If VarType(Last) = vbBoolean Then
        MsgBox "You cancelled."
        Exit Sub
    End If
    If Last < First Then
        MsgBox "Enter a number greater than " & First - 1 & "."
        Exit Sub
    End If
    If Int(Last) <> Last Then
        MsgBox "Enter a WHOLE number greater than " & First - 1 & "."
        Exit Sub
    End If
    
    ' Define column range.
    Dim rg As Range
    Set rg = wb.Worksheets(wsName).Cells(First, cCol).Resize(Last - First + 1)
    
    ' Write values from column range to array.
    Dim Data As Variant
    If rg.Rows.Count > 1 Then
        Data = rg.Value
    Else
        ReDim Data(1 To 1, 1 To 1): Data = rg.Value
    End If
    
    ' Declare additional variables
    Dim cValue As Variant ' Current Value
    Dim i As Long ' Current Row (Array Row Counter)
    Dim fPos As Long ' Current Delimiter Position
    
    ' Replace strings containing the delimiter, with the sub string
    ' to the right of it.
    For i = 1 To UBound(Data)
        cValue = Data(i, 1)
        If Not IsError(cValue) Then
            fPos = InStr(1, cValue, Delim)
            If fPos > 0 Then
                Data(i, 1) = Right(cValue, Len(cValue) - fPos)
            End If
        End If
    Next i
    
    ' Maybe rather test with the following (writes to column 20 ("T")).
    'rg.Offset(, 10).Value = Data
    ' Write values from array to column range.
    rg.Value = Data
    
End Sub

Simple Excel VBA takes ages

2 Answers2

Replace Values In-Place