How to speed up the VBA function

Fixed

Board Regular
Joined
Apr 28, 2017
Messages
95
Hello, friends!

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

Code:
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:

AB (function)B (result)
1a+b+c+d+e+f+g+<strike></strike>=reducer(A1)<strike></strike>a+b+c+d+e+f+<strike></strike>
211-22-33-44-55-66-77-<strike></strike>=reducer(A2)<strike></strike>11-22-33-44-55-66-<strike></strike>
311-22-33-44-55-66-<strike></strike>=reducer(A3)<strike></strike>11-22-33-44-55-<strike></strike>
411-22-33-44-55-<strike></strike>=reducer(A4)<strike></strike>11-22-33-44-<strike></strike>
511-22-33-44-<strike></strike>=reducer(A5)<strike></strike>11-22-33-<strike></strike>
611-22-33-<strike></strike>=reducer(A6)<strike></strike>11-22-<strike></strike>
711-22-<strike></strike>=reducer(A7)<strike></strike>11-<strike></strike>
811-<strike></strike>=reducer(A8)<strike></strike>

<tbody>
</tbody>

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

Thank you in advance.
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
This function may be quicker:
Code:
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:
Code:
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
 
Last edited:
Upvote 0
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
AB
1a+b+c+d+e+f+g+a+b+c+d+e+f+
211-22-33-44-55-66-77-11-22-33-44-55-66-
311-22-33-44-55-66-11-22-33-44-55-
411-22-33-44-55-11-22-33-44-
511-22-33-44-11-22-33-
611-22-33-11-22-
711-22-11-
811-
Sheet1
Cell Formulas
RangeFormula
B1=IFERROR(LEFT(A1,FIND("|",SUBSTITUTE(A1,RIGHT(A1),"|",LEN(A1)-LEN(SUBSTITUTE(A1,RIGHT(A1),""))-1))),"")
 
Upvote 0
JackDanIce, thanks for help, but your code (sub + public function) works for only two rows.
 
Upvote 0
Typo, try:
Code:
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
 
Last edited:
Upvote 0
FormR, thanks for this exciting function, it works, I'll try it on a large amount of data.
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,214,904
Messages
6,122,169
Members
449,070
Latest member
webster33

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top