Speed up Cell replacement VBA

Question

I have a little code that formats phone numbers in a column, in the sense that: -if it has spaces in between, it removes them -after that, takes 9 numbers starting from the right, and checks if it is a integer, and if so, puts that in the cell.

The problem is that it takes nearly 6-7 seconds to do all the replacements (3000 cells, most of them blank). Any idea how to speed up this, pls?

Many thanks

targetSheet.Columns("M:M").Cells.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False
  

For i = 2 To targetSheet.Range("M" & Rows.Count).End(xlUp).Row
    If Len(targetSheet.Cells(i, 13).Value) > 9 Then
        Phone = Right(targetSheet.Cells(i, 13).Value, 9)
        If IsNumeric(Phone) = True Then
            targetSheet.Cells(i, 13).Value = Phone
        Else
            targetSheet.Cells(i, 13).Value = ""
        End If
    End If
Next i```

Answer 1

Cell Replacement by Using an Array

• You could 'apply' the removing of the spaces to the range. For the remaining job, write the range values to an array, modify them and write them back to the range.

EDIT:

• Note that I have added three missing Replace arguments since False is not their default value: MatchCase for sure, the last two unclear. SearchOrder and MatchByte are not important in this case. Read more about it here.

The Code

Option Explicit

Sub test()
    Dim trg As Range
    With targetSheet.Range("M2")
        Set trg = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If trg Is Nothing Then Exit Sub
        Set trg = .Resize(trg.Row - .Row + 1)
    End With
    trg.Replace What:=fnd, Replacement:=rplc, LookAt:=xlPart, _
        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False 
    Dim Data As Variant: Data = trg.Value
    Dim cValue As Variant
    For i = 1 To UBound(Data, 1)
        cValue = Data(i, 1)
        If Not IsError(cValue) Then
            If Len(cValue) > 9 Then
                cValue = Right(cValue, 9)
                If IsNumeric(cValue) Then
                    Data(i, 1) = cValue
                Else
                    Data(i, 1) = ""
                End If
            'Else ' Len(cValue) is lte 9
            End If
        'Else ' error value
        End If
    Next i
    trg.Value = Data
End Sub