CODEWITHSUNDEEP
excelvba
David Pfurtscheller
David Pfurtscheller

Reputation: 21

Simple Excel VBA takes ages

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

Upvotes: 2

Views: 91

Answers (2)

VBasic2008
VBasic2008

Reputation: 54807

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

Upvotes: 0

Siddharth Rout
Siddharth Rout

Reputation: 149295

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),)")

Upvotes: 3

Related Questions