Home » excel » excel vba – How can I optimise a set of VBA functions that parse String and Variant types

excel vba – How can I optimise a set of VBA functions that parse String and Variant types

Posted by: admin May 14, 2020 Leave a comment

Questions:

How can I optimise these functions? They work but I need it to be much faster.

Actual working (slow):

  Function IsInArray(value As String, arr As Variant) As Boolean
        Dim length As Integer
        Dim found As Boolean

        length = UBound(arr)
        found = False
        i = 0
        While Not found And i < length
            If arr(i) = value Then
                found = True
            End If

            i = i + 1
        Wend
        If found Then
            IsInArray = True
        Else
            IsInArray = False
        End If
    End Function

This gets number of rows in specific list:

Function GetNumberOfRows(list As String) As Integer

    Dim numRows As Integer
    Dim row As Integer
    Dim column As Integer

    row = 2
    column = 2
    numRows = 0

    While (Worksheets(list).Cells(row, column).value <> "")
        numRows = numRows + 1
        row = row + 1
    Wend

    GetNumberOfRows = numRows

End Function

This replace values in a range

Sub ReplaceValue(oldValue As String, newValue As String, list As String)

    Dim numRows, numColumns As Integer
    Dim row, column As Integer

    numRows = GetNumberOfRows(list)
    numColumns = 9

    row = 2
    While row <= numRows + 1

        column = 3
        While column <= numColumns + 3

            If Worksheets(list).Cells(row, column).value = oldValue Then
                Worksheets(list).Cells(row, column).value = newValue
            End If

            column = column + 1
        Wend

        row = row + 1
    Wend
End Sub

P.S.

This is fast but isn’t to spec as if I’m searching for “aa”, it will say TRUE if “aab” is in array. However it might be instructive to include it here as an example of ‘fast’.

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean 
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
How to&Answers:

With regard to IsInArray, Filter won’t work, but Join works just fine. This assumes that the accent grave character is not in the array (not a grave concern!):

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    jn = "`" & Join(arr, "`") & "`"
    IsInArray = InStr(1, jn, "`" & stringToBeFound & "`") > 0
End Function

Answer:

For the first one:

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0))
End Function

Not sure I understand what you are tyring to do with the second one, assuming you just want to know the number of used rows:

Function GetNumberOfRows(list As String) As Integer

    GetNumberOfRows = Worksheets(list).UsedRange.Rows.Count -1       

End Function

Or if you want specifically the rows in the second column:

Function GetNumberOfRows(list As String) As Integer

    GetNumberOfRows = Worksheets(list).Cells(rows.count,"B").End(xlUp).Row     

End Function

Third one:

Sub ReplaceValue(oldValue As String, newValue As String, list As String)

Worksheets(list).UsedRange.Replace What:=oldValue, Replacement:=newValue, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

End Sub

Answer:

For the function GetNumberOfRows, you’re passing a worksheet name as an argument? Try this:

Function GetNumberOfRows(list As String) As Integer

    GetNumberOfRows = Worksheets(list).UsedRange.Rows.Count - 1

End Function

I added ‘-1’ if you don’t want to count the header (you’re function started counting at row 2)

Answer:

To check if in array:

Function IsInArray(value As String, arr As Variant) As Boolean

    If Not IsArray(arr) Then
        'the argument arr is not an array, return false
        IsInArray = False
        Exit Function
    End If

    IsInArray = (InStr(1, "||" & Join(arr, "||") & "||", "||" & value & "||", vbTextCompare) > 0)

End Function

To get the number of rows:

Function GetNumberOfRows(list As String) As Integer

    With Sheets(list)
        GetNumberOfRows = WorksheetFunction.Max(0, .Rows.Count - WorksheetFunction.CountBlank(.Columns("B")) - 1)
    End With

End Function

To replace values:

Sub ReplaceValue(oldValue As String, newValue As String, list As String)

    With Intersect(Sheets(list).UsedRange, Sheets(list).Range("C:L"))
        .Replace oldValue, newValue, xlWhole
    End With

End Sub