Macro to delete all text from cells and leave numbers

[mrmonk21]

I need a macro to delete all text from cells and leave the numbers

Please help

 

[Rick Rothstein]

That's excellent! However, I forgot one thing: the space between the two timecode numbers. Anyway to leave spaces alone, too?

00:00:00:01 00:00:00:34

instead of:
00:00:00:0100:00:00:34

Give this version of my macro a try...

Sub RemoveNonDigits()
  Dim X As Long, Z As Long, LastRow As Long, CellVal As String
  Const StartRow As Long = 1
  Const DataColumn As String = "A"
  Application.ScreenUpdating = False
  LastRow = Cells(Rows.Count, DataColumn).End(xlUp).Row
  For X = StartRow To LastRow
    CellVal = Cells(X, DataColumn)
    For Z = 1 To Len(CellVal)
      If Mid(CellVal, Z, 1) Like "[!0-9: ]" Then Mid(CellVal, Z, 1) = Chr$(1)
    Next
    With Cells(X, DataColumn)
      .NumberFormat = "@"
      .Value = Replace(CellVal, Chr$(1), "")
    End With
  Next
  Application.ScreenUpdating = True
End Sub

 

[chirp]

i made this a while ago just to see if the method is faster/slower than some others so i am sure there are some mistakes.

that being said, this is a fairly versatile method that lets you control on a character by character basis what you are "deleting".

its by no means short and by no means optimized but hopefully interesting nonetheless:

Option Explicit
Option Base 0

'used in delete char function
Public Enum whatOperation
    remNumbers = 1
    remAlpha = 2
    remNonNumbers = 4
    remNonAlpha = 8
    remNonPrintable = 16
    remOnlyCustom = 32
End Enum

'used in a few range functions
Public Enum cornerCell
    leftTop = 0
    rightTop = 1
    leftBottom = 2
    rightBottom = 3
End Enum

'works for chrs 0-255
Sub delChars(rng As Range, _
                            Optional whatOp As whatOperation = remNonPrintable, _
                            Optional excludeChrs As String, _
                            Optional includeChrs As String, _
                            Optional tst As Boolean)
Dim enumArr As Variant, tmpVar As Variant
Dim boolEnum() As Boolean, fTest As Boolean, boolByte(0 To 255) As Boolean
Dim i As Long, uBnd2 As Long, j As Long, k As Long, tCnt As Long, tLng As Long
Dim bArr() As Byte
Dim tStr As String
'number of possible enum vals
Const numEnums = 6

tst = False
On Error GoTo exitFunc
If rng Is Nothing Then GoTo exitFunc
Set rng = rUsedrange(rng) 'custom function, makes sure only searching used range

'get array of component powers
enumArr = splitEnums(whatOp, fTest)
If Not fTest Then GoTo exitFunc

'set boolean array (array just to add some convenience)
'note that if a value other than specified enumerated vals are entered this will error
ReDim boolEnum(0 To numEnums - 1)
For Each tmpVar In enumArr
    boolEnum(tmpVar) = True
Next

'check if all chars are deleted
If boolEnum(0) Then
    If boolEnum(2) Then
        rng.ClearContents
        tst = True
        GoTo exitFunc
    End If
End If
        
If boolEnum(1) Then
    If boolEnum(3) Then
        rng.ClearContents
        tst = True
        GoTo exitFunc
    End If
End If

'messy bit
'****************************************************************************
'****************************************************************************

'get other chrs
If excludeChrs <> vbNullString Then
    bArr = excludeChrs
    For i = 0 To UBound(bArr) Step 2
        boolByte(bArr(i)) = True
    Next
ElseIf boolEnum(5) Then '5 is only custom
    tst = True
    GoTo exitFunc
End If

If Not boolEnum(5) Then
    'numbers
    If boolEnum(0) Then
        For i = 48 To 57
            boolByte(i) = True
        Next
    End If
    
    'alpha
    If boolEnum(1) Then
        For i = 65 To 90
            boolByte(i) = True
            boolByte(i + 32) = True
        Next
    End If
    
    'non numeric
    If boolEnum(2) Then
        For i = 0 To 255
            If i < 48 Then
                boolByte(i) = True
            ElseIf i > 57 Then
                boolByte(i) = True
            End If
        Next
    End If
    
    'non alpha
    If boolEnum(3) Then
        For i = 0 To 255
            If i < 65 Then
                boolByte(i) = True
            ElseIf i > 90 Then
                If i < 97 Then
                    boolByte(i) = True
                ElseIf i > 122 Then
                    boolByte(i) = True
                End If
            End If
        Next
    End If
    
    'non printable (these are preference based to some extent)
    If boolEnum(4) Then
        For i = 0 To 31
            boolByte(i) = True
        Next
        boolByte(127) = True
        boolByte(129) = True
        boolByte(141) = True
        boolByte(143) = True
        boolByte(144) = True
        boolByte(157) = True
    End If
End If

'Include str gets preference over exclude
If includeChrs <> vbNullString Then
    bArr = includeChrs
    For i = 0 To UBound(bArr) Step 2
        boolByte(bArr(i)) = False
    Next
End If

'****************************************************************************
'****************************************************************************
'end of  messy bit

'set array from range
If rng.Cells.Count > 1 Then
    tmpVar = rng.Value2
Else
    ReDim tmpVar(1 To 1, 1 To 1)
    tmpVar(1, 1) = rng.Value2
End If

'get ubound save a bit of time if lots of rows
uBnd2 = UBound(tmpVar, 2)
'main loop
If uBnd2 <> 1 Then 'this test saves an extremely small amount of time, could remove
    For i = 1 To UBound(tmpVar)
        For j = 1 To uBnd2
            tStr = tmpVar(i, j)
            If tStr <> vbNullString Then
                bArr = tStr
                tLng = LenB(tStr) - 1
                For k = 0 To tLng Step 2
                    If Not boolByte(bArr(k)) Then
                        bArr(tCnt) = bArr(k)
                        tCnt = tCnt + 2
                    End If
                Next
                If tCnt < tLng Then tmpVar(i, j) = LeftB$(bArr, tCnt)
                tCnt = 0
            End If
        Next
    Next
Else
    For i = 1 To UBound(tmpVar)
        tStr = tmpVar(i, 1)
        If tStr <> vbNullString Then
            bArr = tStr
            For k = 0 To LenB(tStr) - 1 Step 2
                If Not boolByte(bArr(k)) Then
                    bArr(tCnt) = bArr(k)
                    tCnt = tCnt + 2
                End If
            Next
            If tCnt < LenB(tStr) - 1 Then tmpVar(i, 1) = LeftB$(bArr, tCnt)
            tCnt = 0
        End If
    Next
End If

'set array back into range
rng = tmpVar
'set tst var to true as no errors occurred
tst = True
exitFunc:
End Sub

'works for chrs 0-255
Function delCharsSN(inString As String, _
                            Optional whatOp As whatOperation = remNonPrintable, _
                            Optional excludeChrs As String, _
                            Optional includeChrs As String, _
                            Optional tst As Boolean) As String

Dim enumArr As Variant, tmpVar As Variant
Dim boolEnum() As Boolean, fTest As Boolean, boolByte(0 To 255) As Boolean
Dim i As Long, k As Long, tCnt As Long
Dim bArr() As Byte
'number of possible enum vals
Const numEnums = 6

tst = False
On Error GoTo exitFunc
If inString = vbNullString Then GoTo exitFunc

'get array of component powers
enumArr = splitEnums(whatOp, fTest)
If Not fTest Then GoTo exitFunc

'set boolean array\ (array just to add some convenience)
'note that if a value other than specified enumerated vals are entered this will error
ReDim boolEnum(0 To numEnums - 1)
For Each tmpVar In enumArr
    boolEnum(tmpVar) = True
Next

'check if all chars are deleted
If boolEnum(0) Then
    If boolEnum(2) Then
        delCharsSN = vbNullString
        tst = True
        GoTo exitFunc
    End If
End If
        
If boolEnum(1) Then
    If boolEnum(3) Then
        delCharsSN = vbNullString
        tst = True
        GoTo exitFunc
    End If
End If

'messy bit
'****************************************************************************
'****************************************************************************

'get other chrs
If excludeChrs <> vbNullString Then
    bArr = excludeChrs
    For i = 0 To UBound(bArr) Step 2
        boolByte(bArr(i)) = True
    Next
ElseIf boolEnum(5) Then
    tst = True
    GoTo exitFunc
End If

If Not boolEnum(5) Then
    'numbers
    If boolEnum(0) Then
        For i = 48 To 57
            boolByte(i) = True
        Next
    End If
    
    'alpha
    If boolEnum(1) Then
        For i = 65 To 90
            boolByte(i) = True
            boolByte(i + 32) = True
        Next
    End If
    
    'non numeric
    If boolEnum(2) Then
        For i = 0 To 255
            If i < 48 Then
                boolByte(i) = True
            ElseIf i > 57 Then
                boolByte(i) = True
            End If
        Next
    End If
    
    'non alpha
    If boolEnum(3) Then
        For i = 0 To 255
            If i < 65 Then
                boolByte(i) = True
            ElseIf i > 90 Then
                If i < 97 Then
                    boolByte(i) = True
                ElseIf i > 122 Then
                    boolByte(i) = True
                End If
            End If
        Next
    End If
    
    'non printable
    If boolEnum(4) Then
        For i = 0 To 31
            boolByte(i) = True
        Next
        boolByte(127) = True
        boolByte(129) = True
        boolByte(141) = True
        boolByte(143) = True
        boolByte(144) = True
        boolByte(157) = True
    End If
    '****************************************************************************
    '****************************************************************************
    'end of  messy bit
End If

'get other chrs
If includeChrs <> vbNullString Then
    bArr = includeChrs
    For i = 0 To UBound(bArr) Step 2
        boolByte(bArr(i)) = False
    Next
End If

bArr = inString
For k = 0 To LenB(inString) - 1 Step 2
    If Not boolByte(bArr(k)) Then
        bArr(tCnt) = bArr(k)
        tCnt = tCnt + 2
    End If
Next
If tCnt = k Then delCharsSN = inString Else delCharsSN = LeftB$(bArr, tCnt)

tst = True
exitFunc:
End Function
Function delCharsSE(inString As String, _
                            Optional whatOp As whatOperation = remNonPrintable, _
                            Optional excludeChrs As String, _
                            Optional includeChrs As String, _
                            Optional tst As Boolean) As String

Dim enumArr As Variant, tmpVar As Variant
Dim boolEnum() As Boolean, fTest As Boolean, boolByte(0 To 255) As Boolean
Dim i As Long, k As Long, tCnt As Long
Dim bArr() As Byte
'number of possible enum vals
Const numEnums = 6

tst = False
On Error GoTo exitFunc
If inString = vbNullString Then GoTo exitFunc

'get array of component powers
enumArr = splitEnums(whatOp, fTest)
If Not fTest Then GoTo exitFunc

'set boolean array\ (array just to add some convenience)
'note that if a value other than specified enumerated vals are entered this will error
ReDim boolEnum(0 To numEnums - 1)
For Each tmpVar In enumArr
    boolEnum(tmpVar) = True
Next

'check if all chars are deleted
If boolEnum(0) Then
    If boolEnum(2) Then
        inString = vbNullString
        tst = True
        GoTo exitFunc
    End If
End If
        
If boolEnum(1) Then
    If boolEnum(3) Then
        inString = vbNullString
        tst = True
        GoTo exitFunc
    End If
End If

'messy bit
'****************************************************************************
'****************************************************************************

'get other chrs
If excludeChrs <> vbNullString Then
    bArr = excludeChrs
    For i = 0 To UBound(bArr) Step 2
        boolByte(bArr(i)) = True
    Next
ElseIf boolEnum(5) Then
    tst = True
    GoTo exitFunc
End If

If Not boolEnum(5) Then
    'numbers
    If boolEnum(0) Then
        For i = 48 To 57
            boolByte(i) = True
        Next
    End If
    
    'alpha
    If boolEnum(1) Then
        For i = 65 To 90
            boolByte(i) = True
            boolByte(i + 32) = True
        Next
    End If
    
    'non numeric
    If boolEnum(2) Then
        For i = 0 To 255
            If i < 48 Then
                boolByte(i) = True
            ElseIf i > 57 Then
                boolByte(i) = True
            End If
        Next
    End If
    
    'non alpha
    If boolEnum(3) Then
        For i = 0 To 255
            If i < 65 Then
                boolByte(i) = True
            ElseIf i > 90 Then
                If i < 97 Then
                    boolByte(i) = True
                ElseIf i > 122 Then
                    boolByte(i) = True
                End If
            End If
        Next
    End If
    
    'non printable
    If boolEnum(4) Then
        For i = 0 To 31
            boolByte(i) = True
        Next
        boolByte(127) = True
        boolByte(129) = True
        boolByte(141) = True
        boolByte(143) = True
        boolByte(144) = True
        boolByte(157) = True
    End If
    '****************************************************************************
    '****************************************************************************
    'end of  messy bit
End If

'get other chrs
If includeChrs <> vbNullString Then
    bArr = includeChrs
    For i = 0 To UBound(bArr) Step 2
        boolByte(bArr(i)) = False
    Next
End If

bArr = inString
For k = 0 To LenB(inString) - 1 Step 2
    If Not boolByte(bArr(k)) Then
        bArr(tCnt) = bArr(k)
        tCnt = tCnt + 2
    End If
Next
If tCnt = k Then inString = LeftB$(bArr, tCnt)

tst = True
exitFunc:
End Function


'gets the real used range using the first/last col/row functions
Function rUsedrange(withinRange As Range, _
                            Optional LookIn As XlFindLookIn = xlFormulas, _
                            Optional showAllData As Boolean = False, _
                            Optional tst As Boolean) As Range
Dim lr As Long, fr As Long, lc As Long, fc As Long

tst = False
On Error GoTo exitFunc
If withinRange Is Nothing Then GoTo exitFunc
With withinRange.Parent
    'will catch values that are in hidden rows/cols eiter way
    If showAllData Then If .FilterMode Then .showAllData
    lr = lastRow(withinRange, LookIn)
    If lr < 1 Then GoTo exitFunc
    fr = firstRow(withinRange, LookIn)
    lc = LastCol(withinRange, LookIn)
    fc = firstCol(withinRange, LookIn)
    Set rUsedrange = .Range(.Cells(fr, fc), .Cells(lr, lc))
End With

tst = True
exitFunc:
End Function

'THESE USE THE FIND METHOD FOR LAST/FIRST ROW/COL, use if searching full sheet/large range
'gets last/first row/column (searches within values or formulas)
'the find method seems to have an overhead of about .25 seconds/1000 calls
'the increase in time/range size is then about .7 seconds/2560000 searched cells/1000 calls

Public Function lastRow(withinRange As Range, _
                        Optional LookIn As XlFindLookIn = xlFormulas, _
                        Optional tst As Boolean) As Long
Dim ar As Range, tmp As Long, t As Long
tst = False
On Error GoTo exitFunc
If withinRange Is Nothing Then GoTo exitFunc

With withinRange
    If .Areas.Count < 2 Then
        lastRow = .Find("*", getCornerRange(withinRange, leftTop), LookIn, xlPart, xlByRows, xlPrevious).Row
    Else
        t = .Row + .Rows.Count - 1
        For Each ar In .Areas
            tmp = .Find("*", getCornerRange(ar, leftTop), LookIn, xlPart, xlByRows, xlPrevious).Row
            If tmp > lastRow Then
                lastRow = tmp
                If lastRow = t Then Exit For
            End If
        Next
    End If
End With
tst = True
exitFunc:
If lastRow < 1 Then lastRow = -1
End Function

Public Function LastCol(withinRange As Range, _
                        Optional LookIn As XlFindLookIn = xlFormulas, _
                        Optional tst As Boolean) As Long
Dim ar As Range, tmp As Long, t As Long
tst = False
On Error GoTo exitFunc
With withinRange
    If .Areas.Count < 2 Then
        LastCol = .Find("*", getCornerRange(withinRange, leftTop), LookIn, xlPart, xlByColumns, xlPrevious).Column
    Else
        t = .Column + .Columns.Count - 1
        For Each ar In .Areas
            tmp = .Find("*", getCornerRange(ar, leftTop), LookIn, xlPart, xlByColumns, xlPrevious).Column
            If tmp > LastCol Then
                LastCol = tmp
                If LastCol = t Then Exit For
            End If
        Next
    End If
End With
tst = True
exitFunc:
If LastCol < 1 Then LastCol = -1
End Function

Public Function firstRow(withinRange As Range, _
                        Optional LookIn As XlFindLookIn = xlFormulas, _
                        Optional tst As Boolean) As Long

Dim ar As Range, tmp As Long, notFirst As Boolean, t As Long
tst = False
On Error GoTo exitFunc
If withinRange Is Nothing Then GoTo exitFunc
With withinRange
    If .Areas.Count < 2 Then
        firstRow = .Find("*", getCornerRange(withinRange, rightBottom), LookIn, xlPart, xlByRows, xlNext).Row
    Else
        t = .Row
        For Each ar In .Areas
            tmp = .Find("*", getCornerRange(ar, rightBottom), LookIn, xlPart, xlByRows, xlNext).Row
            If tmp <> 0 Then
                If notFirst Then
                    If tmp < firstRow Then
                        firstRow = tmp
                        If firstRow = t Then Exit For
                    End If
                Else
                    notFirst = True
                    firstRow = tmp
                    If firstRow = t Then Exit For
                End If
            End If
            
        Next
    End If
End With

tst = True
exitFunc:
If firstRow < 1 Then firstRow = -1
End Function

Public Function firstCol(withinRange As Range, _
                        Optional LookIn As XlFindLookIn = xlFormulas, _
                        Optional tst As Boolean) As Long

Dim ar As Range, tmp As Long, notFirst As Boolean, t As Long
tst = False
On Error GoTo exitFunc
If withinRange Is Nothing Then GoTo exitFunc
With withinRange
    If .Areas.Count < 2 Then
        firstCol = .Find("*", getCornerRange(withinRange, rightBottom), LookIn, xlPart, xlByColumns, xlNext).Column
    Else
        t = .Column
        For Each ar In .Areas
            tmp = .Find("*", getCornerRange(ar, rightBottom), LookIn, xlPart, xlByColumns, xlNext).Column
            If tmp <> 0 Then
                If notFirst Then
                    If tmp < firstCol Then
                        firstCol = tmp
                        If firstCol = t Then Exit For
                    End If
                Else
                    notFirst = True
                    firstCol = tmp
                    If firstCol = t Then Exit For
                End If
            End If
        Next
    End If
End With

tst = True
exitFunc:
If firstCol < 1 Then firstCol = -1
End Function

'gets the specified corner of a range
'left top fastest, left bottom slowest

Function getCornerRange(rng As Range, _
                                Optional whichCorner As cornerCell = rightBottom, _
                                Optional tst As Boolean) As Range
Dim funcTest As Boolean
Dim lBnd As Long

tst = False
On Error GoTo exitFunc

'could use a "with" block here but of margninal impact
If rng.Areas.Count = 1 Then
    Select Case whichCorner
        Case 0 'lefttop
            Set getCornerRange = rng.Cells(1)
        Case 1 'right top
            Set getCornerRange = rng.Cells(rng.Columns.Count)
        Case 2 'left bottom
            Set getCornerRange = rng.Cells(rng.Rows.Count, 1)
        Case 3 'right bottom
            Set getCornerRange = rng.Cells(rng.Rows.Count, rng.Columns.Count)
    End Select
Else
    Set getCornerRange = getCornerRange(getBoundRange(rng, funcTest), whichCorner, tst)
    GoTo exitFunc
End If

tst = True
exitFunc:
End Function

Function getBoundRange(r As Range, _
                            Optional tst As Boolean) As Range
    ' Returns a single-area range bounding the areas in r
    ' pgc01 http://www.mrexcel.com/forum/showpos...64&postcount=3
    Dim i As Long
    
    tst = False
    On Error GoTo exitFunc
    If r Is Nothing Then Exit Function
    
    Set getBoundRange = r.Areas(1)
    For i = 2 To r.Areas.Count
        Set getBoundRange = Range(getBoundRange, r.Areas(i))
    Next i
    
    tst = True
exitFunc:
End Function

'returns 2^x components (binary parts) of a given number
'fairly slow. 1.0s/100000 for input=~70000
Function splitEnums(totEnum As Long, _
                            Optional tst As Boolean) As Variant
Dim i As Long, tmpVal As Long, tCnt As Long
Dim retArr As Variant

tst = False
On Error GoTo exitFunc

If totEnum < 1 Then GoTo exitFunc
ReDim retArr(0 To 31) 'max size of long

For i = 0 To getPower(totEnum)
    If (2 ^ i And totEnum) Then
        retArr(tCnt) = i
        tCnt = tCnt + 1
    End If
Next

ReDim Preserve retArr(0 To tCnt - 1)
splitEnums = retArr

tst = True
exitFunc:
End Function

'returns the largest power of some base within a number
Function getPower(num, Optional Base As Long = 2) As Long
    On Error Resume Next
    getPower = Int(Round(Log(num) / Log(Base), 15)) '15 maximum precision
End Function

in your case you could use it like:

Sub test
    delChars Columns(1), remNonNumbers, , " :"
end sub

 

[ZVI]

00:00:00:01 00:00:00:34

instead of:
00:00:00:0100:00:00:34

If not to be afraid of regular expressions and if speed is necessary

Dim RegEx As Object
Sub Txt2Num()
  Dim c As Range
  If RegEx Is Nothing Then
    ' Initiate RegEx only once for the fast performing
    Set RegEx = CreateObject("VBScript.RegExp")
    RegEx.Global = True
    ' [^] means except, i.e. "character non in set"
    ' :   - colon symbol
    ' \d  - digits
    ' \s  - whitespaces (tab, space, line breaks)
    RegEx.Pattern = "[^:\d\s]"  ' or = "[^:\d ]"
  End If
  ' Process each cell in selection
  With RegEx
    For Each c In Selection
      If VarType(c) = vbString Then
        c.Value = Trim(.Replace(c.Value, ""))
      End If
    Next
  End With
End Sub

 

[mirabeau]

seems like a good, fun thread.

maybe try this one too, for variety if nothing else

Sub another()
Dim rws As Long, i As Long, j As Long
Dim a As Variant, u As String, c As String
rws = Range("A" & Rows.Count).End(xlUp).Row
a = Range("A1:A" & rws)

For i = 1 To rws
u = vbNullString
    For j = 1 To Len(a(i, 1))
        c = Mid(a(i, 1), j, 1)
        If (IsNumeric(c)) + (c = ":") + (c = " ") Then u = u & c
    Next j
a(i, 1) = u
Next i
Range("A1").Resize(rws) = a

End Sub

 

[chirp]

@ZVI that alone will still be much slower than my previously posted method (based on tests in 2010, with the three sample lines copied down to row ~50000)

you would want to do something like this (just modified yours):

Sub Txt2Num(rng As Range)
  Dim c As Range, v As Variant, i As Long, j As Long, ubnd2 As Long
  If RegEx Is Nothing Then
    ' Initiate RegEx only once for the fast performing
    Set RegEx = CreateObject("VBScript.RegExp")
    RegEx.Global = True
    ' [^] means except, i.e. "character non in set"
    ' :   - colon symbol
    ' \d  - digits
    ' \s  - whitespaces (tab, space, line breaks)
    RegEx.Pattern = "[^:\d\s]"  ' or = "[^:\d ]"
  End If
  
    If rng.Cells.Count > 1 Then
        v = rng.Value2
    Else
        ReDim v(1 To 1, 1 To 1)
        v(1, 1) = rng.Value2
    End If
  
    ubnd2 = UBound(v, 2)
    ' Process each cell in selection
    With RegEx
        For i = 1 To UBound(v)
            For j = 1 To UBound(v, 2)
                If v(i, j) <> vbNullString Then v(i, j) = Trim(.Replace(v(i, j), ""))
            Next
        Next
    End With
    rng = v
End Sub

i think that the rng-> var array is consistently faster across data types etc but can run into memory limits so that is one negative.

the simplicity of this method and the similar speed as my iterative method has finally convinced me to learn regular expressions.

 

[Rick Rothstein]

...and if speed is necessary

Yes, your code is faster than mine, but not so much so that speed should be of any real consideration. To put our code on equal footing, I disabled/re-enabled screen updating in your code (it makes a difference... your code was slower than mine without it). To process 10,000 cells (on my computer) containing a mix of what the latest poster posted as samples of his data... my code took 1.34 seconds to complete and your took one second exactly. While your code was some one-third faster than mine, I am not sure I would say the overall extra one-third of a second to process a total of 10,000 cells is at all significant, speed-wise.

EDIT NOTE: Interestingly, for 1000 data cells, my code ended up being faster... 0.22 seconds for your code, 0.16 seconds for my code.

 

[chirp]

@rick

thats probably because "creating" the reg ex object is relatively slow...methods that change the sheet cell by cell are still at a distinct disadvantage over a rng-array: array-rng approach.

did you test the alteration of zti's method i posted? as far as i can tell it is more than 30% faster than your original post...additionally if you dont mind i would like to know how my original post compares!

thanks!

 

[mirabeau]

hmm ...

since such a good fun thread seems to have turned into a speed enthusiast's convention

then consider the following

the three lines filled down to 50,000 lines as per chirp, and several timed codes run on my machine

times were:

mirabeau 1.36 secs
zvi 2.93 secs
rick 9.75 secs
chirp ??

 

[ZVI]

...you would want to do something like this (just modified yours):
...
i think that the rng-> var array is consistently faster across data types etc but can run into memory limits so that is one negative.

Hi chirp,
Thank you for improving code! Certainly, processing array is the key for speeding up the range processing.

...the simplicity of this method and the similar speed as my iterative method has finally convinced me to learn regular expressions.

Nice!

Interestingly, for 1000 data cells, my code ended up being faster... 0.22 seconds for your code, 0.16 seconds for my code.

Hi Rick, typically RegEx itself is faster than Mid operation.
But for me there always should be common sense in choosing of the method.
Because for particular data the difference in milliseconds of different methods does not matter

hmm ...

since such a good fun thread seems to have turned into a speed enthusiast's convention

Seems it's my fault, as word "speed" has been mentioned

 

[chirp]

its funny how speeds differ by setup, and goes to show that optimization is not universal.

chirp: 1.36
zti adjusted: 1.65
zti: 4.75
miribeau: 5.14
rick: 6.46