How to remove non numeric characters from a cell/column

Question

My current solution to removing all non numeric characters from cells in a specific column (AK) takes my code 7 minutes to run for 360 rows. When I Run the code selecting the all 360 cells with 'application selection' it only takes 10 seconds to run. Optimally I would like to have the Macro select the criteria on its own. Please note the data is pulled in from a query though excel.

I have searched the web, but found nothing where the code selects the column on its own. The Code I created on my own takes 7 minutes vs 10 seconds.

The below code takes 7 minutes to run, but doesn't require the user to select the data.

Dim finRow As String
    finRow = ActiveSheet.Range("A100000").End(xlUp).Row

Set myRange = ActiveSheet.Range("AK2:AK" & finRow)
For Each myCell In myRange
    LastString = ""
    For I = 1 To Len(myCell.Value)
        mT = Mid(myCell.Value, I, 1)
        If mT Like "[0-9]" Then
            tString = mT
        Else
            tString = ""
        End If
        LastString = LastString & tString
    Next I
    myCell.Value = LastString
Next

The Code below takes 10 seconds but the user will have to select the criteria each time the code is run.

Set myRange = Application.Selection
Set myRange = Application.InputBox("select one Range that you want to remove non numeric characters", "RemoveNonNum", myRange.Address, Type:=8)
For Each myCell In myRange
   LastString = ""
    For I = 1 To Len(myCell.Value)
        mT = Mid(myCell.Value, I, 1)
        If mT Like "[0-9]" Then
            tString = mT
        Else
            tString = ""
        End If
        LastString = LastString & tString
    Next I
   myCell.Value = LastString
Next

I expect the output to be 10 seconds when the code selects the criteria on its own. I appreciate all the help. Thank you, Matt

Is there a pattern for the numeric characters? Are they always at the end? — Damian, Mar 28 '19 at 14:00
`finRow = ActiveSheet.Range("A100000").End(xlUp).Row` does this return 360 ? The only reason i can think off for going as slow is that it actually returns a much higher number for finRow than you expect (even if cells that contain formula, but result is "", it still counts as a populated row). Can't see any other reason your code would work much slower. — FAB, Mar 28 '19 at 14:03
Let me know if you feel this is not a duplicate and I will re-open it :) — Siddharth Rout, Mar 28 '19 at 14:11
@SiddharthRout cool formula on the dup. With Office 365 and the use of CONCAT: `=--CONCAT(IFERROR(--MID(A1,ROW($XFD$1:INDEX(XFD:XFD,LEN(A1))),1),""))` Still an array. This is one I use. — Scott Craner, Mar 28 '19 at 14:15
@DarXyde I think you are on the right track. I shortened finrow to 10,000 and it ran flawlessly. There must be ghost cells in my workbook. — Matt Lane, Mar 28 '19 at 14:15
@MattLane you can always add a `Debug.Print finRow` after you set it, or step through code and check what the value is... then check your sheet for the data. On the opposite end is also the fact that if you think there shouldn't be anything there, just delete all rows under your data, that should clear the issue i guess. Scott already pointed below the right aproach, though for 360 rows I wouldn't have bothered to resort on arrays either. At the end of the day, the less interaction with the sheet, the better... and looping through each cell is not the recommended. — FAB, Mar 29 '19 at 09:52

score 4 · Answer 1 · answered Mar 28 '19 at 14:04

Use a variant array and iterate that. Iterating ranges are time consuming.

Dim finRow As Long
finRow = ActiveSheet.Range("A100000").End(xlUp).Row

Dim myRange() As Variant
myRange = ActiveSheet.Range("AK2:AK" & finRow)

Dim k As Long
For k = LBound(myRange, 1) To UBound(myRange, 1)
    Dim lastSring As String
    laststring = ""

    Dim i As Long
    For i = 1 To Len(myRange(k, 1))
        Dim mT As String
        mT = Mid(myRange(k, 1), i, 1)
        If mT Like "[0-9]" Then
            laststring = laststring & mT
        End If
    Next i
    myRange(k, 1) = laststring
Next

ActiveSheet.Range("AK2:AK" & finRow).Value = myRange

I agree with the arrays being the best aproach for large data, but for 360 rows really shouldn't matter. — FAB, Mar 29 '19 at 09:47

score 1 · Answer 2 · answered Mar 28 '19 at 14:05

Does this improve your speed?:

Sub WhatEver()
    Dim finRow As Long, myRange As Range, I As Long
    Dim LastString As String, tString As String, mT As String
    Dim myCell As Range, v As Variant

    finRow = Cells(Rows.Count, "AK").End(xlUp).Row
    Set myRange = ActiveSheet.Range("AK2:AK" & finRow)


    For Each myCell In myRange
        v = myCell.Value
        If v <> "" Then
            LastString = ""
            For I = 1 To Len(v)
                mT = Mid(v, I, 1)
                If mT Like "[0-9]" Then
                    tString = mT
                Else
                    tString = ""
                End If
                LastString = LastString & tString
            Next I
        End If
        myCell.Value = LastString
    Next myCell
End Sub

You confirmed my thought. I think I have ghost cells. my computer froze. if I lower finrow to 10,000 it only runs for 10 seconds. I will have to think of an alternative. Thanks — Matt Lane, Mar 28 '19 at 14:27

How to remove non numeric characters from a cell/column

2 Answers2