How to speed up the VBA function

[Fixed]

Hello, friends!

I've wrote some function that reduces the strings by the last symbol:

Function reducer(ByVal txt As String) As String
txt = Left(txt, InStrRev(Left(txt, Len(txt) - 1), Right(txt, 1)))
reducer = txt
End Function

Example:

[TABLE="width: 500"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B (function)[/TD]
[TD="align: center"]B (result)[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]a+b+c+d+e+f+g+<strike></strike>[/TD]
[TD]=reducer(A1)<strike></strike>[/TD]
[TD]a+b+c+d+e+f+<strike></strike>[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]11-22-33-44-55-66-77-<strike></strike>[/TD]
[TD]=reducer(A2)<strike></strike>[/TD]
[TD]11-22-33-44-55-66-<strike></strike>[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]11-22-33-44-55-66-<strike></strike>[/TD]
[TD]=reducer(A3)<strike></strike>[/TD]
[TD]11-22-33-44-55-<strike></strike>[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]11-22-33-44-55-<strike></strike>[/TD]
[TD]=reducer(A4)<strike></strike>[/TD]
[TD]11-22-33-44-<strike></strike>[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]11-22-33-44-<strike></strike>[/TD]
[TD]=reducer(A5)<strike></strike>[/TD]
[TD]11-22-33-<strike></strike>[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]11-22-33-<strike></strike>[/TD]
[TD]=reducer(A6)<strike></strike>[/TD]
[TD]11-22-<strike></strike>[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]11-22-<strike></strike>[/TD]
[TD]=reducer(A7)<strike></strike>[/TD]
[TD]11-<strike></strike>[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]11-<strike></strike>[/TD]
[TD]=reducer(A8)<strike></strike>[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

But it works slow when the number of strings > 100k.
How to speed up this function?

Thank you in advance.

 

[JackDanIce]

This function may be quicker:

Public Function reducer(ByRef var As String) As String

reducer = Left$(var, InStrRev(Left$(var, Len(var) - 1), Right$(var, 1)))

End Function

But if you use the function inside the following procedure which outputs the results in column B as value, it may be faster yet, instead of processing the UDF on the sheet:

Sub ProcessData()

    Dim arr()   As Variant
    Dim x       As Long
    
    x = Cells(Rows.count, 1).End(xlUp).row
    arr = Cells(1, 1).Resize(x, 2).Value
    
    For x = LBound(arr, 1) To UBound(arr, 2)
        arr(x, 2) = reducer(CStr(arr(x, 1)))
    Next x

    Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    Erase arr

End Sub

Public Function reducer(ByRef var As String) As String

reducer = Left$(var, InStrRev(Left$(var, Len(var) - 1), Right$(var, 1)))

End Function

 

[FormR]

A result obtained with native functions might also perform slightly better - but having any formula operate over that many rows is going to get sluggish!

Excel 2013/2016
	A	B
1	a+b+c+d+e+f+g+	a+b+c+d+e+f+
2	11-22-33-44-55-66-77-	11-22-33-44-55-66-
3	11-22-33-44-55-66-	11-22-33-44-55-
4	11-22-33-44-55-	11-22-33-44-
5	11-22-33-44-	11-22-33-
6	11-22-33-	11-22-
7	11-22-	11-
8	11-
Sheet1

Cell Formulas
Range	Formula
B1	=IFERROR(LEFT(A1,FIND("|",SUBSTITUTE(A1,RIGHT(A1),"|",LEN(A1)-LEN(SUBSTITUTE(A1,RIGHT(A1),""))-1))),"")

 

[Fixed]

JackDanIce, thanks for help, but your code (sub + public function) works for only two rows.

 

[JackDanIce]

Typo, try:

Sub ProcessData()

    Dim arr()   As Variant
    Dim x       As Long
    
    x = Cells(Rows.count, 1).End(xlUp).row
    arr = Cells(1, 1).Resize(x, 2).Value
    
    For x = LBound(arr, 1) To UBound(arr, 1)
        arr(x, 2) = reducer(CStr(arr(x, 1)))
    Next x

    Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    Erase arr

End Sub


Public Function reducer(ByRef var As String) As String

reducer = Left$(var, InStrRev(Left$(var, Len(var) - 1), Right$(var, 1)))

End Function

 

[Fixed]

FormR, thanks for this exciting function, it works, I'll try it on a large amount of data.

 

[Fixed]

Typo, try:

It works perfectly, thank you

 

[FormR]

I'll try it on a large amount of data.

I wouldn't hold your breath, the performance gains will likely be small! You'd be better to use JackDanIce's suggestion I'd think.

 

[Fixed]

Thank you for suggestion, I'll check for speed all 3 methods to know for sure.

 

[Fixed]

I'll check for speed all 3 methods to know for sure.

I've checked these 3 methods on 100k strings:

My UDF = 70 sec
JackDanIce's macro = 1 sec
FormR's function = 1 sec