Excel VBA costum formula too slow

Question

I have this vba excel costum formula:

'=ConcatenateRangeIfs(A1;Sheet2!C:C;B1;Sheet2!D:D;Sheet2!G:G;". ")
Function ConcatenateRangeIfs( _
    ByVal match_val1 As String, _
    ByVal match_range1 As Range, _
    ByVal match_val2 As String, _
    ByVal match_range2 As Range, _
    ByVal concatenate_range As Range, _
    Optional ByVal separator As String _
) As String

'disable uncessary processing to improve performance
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Dim concatedString As String
Dim toConcatenateCellValue As String
Dim toConcatenateCellRow As Long

For Each toConcatenateCell In concatenate_range.SpecialCells(xlConstants, 23)
    toConcatenateCellValue = toConcatenateCell.Value
    If Not IsEmpty(toConcatenateCellValue) Then
        toConcatenateCellRow = toConcatenateCell.Row
        If match_val1 = match_range1.Cells(toConcatenateCellRow, 1).Value Then
            If match_val2 = match_range2.Cells(toConcatenateCellRow, 1).Value Then
                concatedString = concatedString & (separator & toConcatenateCellValue)
            End If
        End If
    End If
Next toConcatenateCell

If Len(concatedString) <> 0 Then
    concatedString = Right$(concatedString, (Len(concatedString) - Len(separator)))
End If

'enable disabled processing
ConcatenateRangeIfs = concatedString
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

End Function

The sheet2 example:

The sheet1 example where the formula is in column D:D cells:

Don't understand why but it takes too long and freezes excel every time I change any of the values used in the formula. I've tried disabling unecessary excel stuff, and use local veriables to access objects properties but didn't change much...

Any sugestion to improve performance?

First thing I could spot: toConcatenateCellValue = toConcatenateCell.Value dont do this assignment when you don't have a match. You don't need this temporary variable at all in fact, it's a useless copy that is performed on all the cells including those that don't match! — A.S.H
A String can never be Empty, so Not IsEmpty(toConcatenateCellValue) is always going to be True. — YowE3K

Charles Williams Charles Williams · Accepted Answer · 2017-02-18T20:20:44

This should be faster:

Option Explicit
'=ConcatenateRangeIfs(A1;Sheet2!C:C;B1;Sheet2!D:D;Sheet2!G:G;". ")
Function ConcatenateRangeIfs( _
         ByVal match_val1 As String, _
         ByRef match_range1 As Variant, _
         ByVal match_val2 As String, _
         ByRef match_range2 As Variant, _
         ByRef concatenate_range As Variant, _
         Optional ByVal separator As String _
       ) As String

    Dim concatedString As String
    Dim toConcatenateCellValue As String
    Dim j As Long

    ' get data into variant arrays
5    If TypeOf match_range1 Is Range Then
        Set match_range1 = Intersect(match_range1.Parent.UsedRange, match_range1)
        match_range1 = match_range1.Value2
    End If
    If TypeOf match_range2 Is Range Then
        Set match_range2 = Intersect(match_range2.Parent.UsedRange, match_range2)
        match_range2 = match_range2.Value2
    End If
    If TypeOf concatenate_range Is Range Then
        Set concatenate_range = Intersect(concatenate_range.Parent.UsedRange, concatenate_range)
        concatenate_range = concatenate_range.Value2
    End If
    '
    ' assumes all arrays are equal length - no error checking
    '
    For j = 1 To UBound(match_range1)
        If Not IsEmpty(concatenate_range(j, 1)) Then
            If match_val1 = match_range1(j, 1) Then
                If match_val2 = match_range2(j, 1) Then
                    concatedString = concatedString & (separator & concatenate_range(j, 1))
                End If
            End If
        End If
    Next j

    If Len(concatedString) <> 0 Then
        concatedString = Right$(concatedString, (Len(concatedString) - Len(separator)))
    End If
ConcatenateRangeIfs = concatedString

End Function

Excel VBA costum formula too slow

1 Answers