Fastest way to remove characters from cell

Question

What is the fastest way to remove characters for each cell? I have 300k rows, looping every single cell is not ideal. I tried text to column but i would need to know how many symbols there could be within each cell. Is there a better way to do this?

Here's what I have looping 300,000 cell. It takes way too much time.

For Each destineCell In destinRange
    cellVal = destineCell.Value
    If (InStr(cellVal, ", ")) Then
        removed = Left(cellVal, InStr(cellVal, ", ") - 1)
        ActiveCell.Value = removed & " "
    End If
    ActiveCell.Offset(1, 0).Select
Next destineCell

[[Update]] Here's what a sample data would look like..

New York, NY, USA
Rome, Italy - Tier 1 City

the data itself varies. Sometimes it'll have a comma, a dash or both.

Answer 1

What is the fastest way to remove characters for each cell? I have 300k rows, looping every single cell is not ideal. I tried text to column but i would need to know how many symbols there could be within each cell. Is there a better way to do this?

@pnuts basically remove everything after the comma or - – JamAndJammies 42 mins ago

@pnuts after the first comma/dash – JamAndJammies 37 mins ago

Based on your question and what you said in the comment, the most simplest and fastest way which will not use VBA is

1. Set a single letter delimiter which you feel will not be in the data. Let's say it is |. Or you can choose some other special character? Let's call this keyword.
2. Press Ctrl + H to bring up find and replace dialog box and do a replace. Find , and replace it with the keyword. Similarly replace - with the keyword.
3. Do Text To columns and split it on the keyword.
4. Keep the 1st column and delete the rest of the columns

Answer 2

You can copy the range into Array, iterate over array replacing the values and then paste the array back. Thus you'll limit Excel recalc calls -- it should be light years faster on 300k, even faster than Range.Replace. Here is an example:

Sub fastReplace()

    ' range to run the replace operation on
    Dim rngRepl As Range
    Set rngRepl = ActiveSheet.[a1:a4]

    ' read range into array (it is a 2D array)
    Dim arr()
    arr = rngRepl

    ' do the replace
    Dim i As Long
    Dim j As Long
    For i = LBound(arr, 1) To UBound(arr, 1)
        For j = LBound(arr, 2) To UBound(arr, 2)
            arr(i, j) = Replace(arr(i, j), "o", "a")
        Next j
    Next i

    ' paste array back
    rngRepl = arr

End Sub

Answer 3

Both methods actually take a similar time for 300,000 data points, around 0.5 seconds on my system.

I did update the array code to handle for the actual replacement required, and more importantly to test for the presence of the string to be replaced (else the code fails).

I didn't play with the extra columns in the other code, I would probably use a copy of the sheet before using this method so that all other columns could be deleted without impacting existing other data.

Code to time approaches

Sub Overall()
Dim dbTime As Double
Dim lngCalc As Long

With Application
 .ScreenUpdating = False
 lngCalc = .Calculation
 .EnableEvents = False
End With

dbTime = Timer()
Call fastReplace
Debug.Print Timer() - dbTime
dbTime = Timer()
Call SD
Debug.Print Timer() - dbTime

With Application
 .ScreenUpdating = True
 .Calculation = lngCalc
 .EnableEvents = True
End With

End Sub

Tidied up array

 Sub fastReplace()

    ' range to run the replace operation on
    Dim rngRepl As Range
    Dim arr()

    Set rngRepl = ActiveSheet.[a1:a300000]

    arr = rngRepl

    ' do the replace
    Dim i As Long
    Dim j As Long
    For i = LBound(arr, 1) To UBound(arr, 1)
        For j = LBound(arr, 2) To UBound(arr, 2)
            If InStr(arr(i, j), ", ") > 0 Then arr(i, j) = Left$(arr(i, j), InStr(arr(i, j), ", ") - 1)
        Next j
    Next i

    ' paste array back
    rngRepl.Value2 = arr

End Sub

Text to Columns

Sub SD()
 [a1:a300000].TextToColumns , , , , , , True
End Sub

Answer 4

Or a one-line VBA equivalent of using LEFT on each string:

[a1:A300000] = Application.Evaluate("=IF(ISERR(FIND("","",A1:a300000)),A1:A300000,LEFT(A1:A300000,FIND("","",A1:A300000)-1))")

Answer 5

EDIT

Try this and change your range, accordingly:

Option Explicit

Sub FindAndReplace()

Dim Arr() As Variant
Arr = Range("A1:A3")

Dim x As Integer

For x = LBound(Arr) To UBound(Arr)
    Arr(x, 1) = Left(Arr(x, 1), InStr(Arr(x, 1), ",") - 1)
Next x
Range("A1").Resize(UBound(Arr), 1) = Arr

End Sub