VBA Code Using Arrays To Be Optimized

Use a dictionary, don't redim preserve. It's nasty since it copies the entire array each time you want to add to it

Notwithstanding all the comments about redim preserve, here's some points and code you can try:

ConcatCodes.xlsm

Your example seems to imply that you only need to do a single code search at a time. For this, your code looks quite efficient as it is. I'd just make it friendlier for normal spreadsheet use by turning it into a user defined function.

Public Function JoinCodes(SourceRng As Excel.Range, FindCode As String) As String
    Dim R As Variant, Counter As Integer, NewVal(), C As Integer
    Application.Volatile
    R = SourceRng.Value
    For Counter = LBound(R) To UBound(R)
        If R(Counter, 1) = FindCode Then
            C = C + 1
            ReDim Preserve NewVal(1 To C)
            NewVal(C) = R(Counter, 2)
        End If
    Next Counter
    JoinCodes = FindCode & " " & Join(NewVal, ",")
End Function

With this you don't need a 'firing' mechanism to run the macro, ie. your Worksheet_Change code. You can just enter this formula in E1:

=JoinCodes($A$1:$B$16,$D1)

But if you really are looking for speed optimisation, then the one logical improvement I'd apply is to do all the codes in one pass. In theory, this code should be a speedup, but your testing may prove me wrong. The procedure outputs a 2-column table of results using TargetCell as the top-left corner.

Public Sub JoinCodeTable(SourceRng As Excel.Range, TargetCell As Excel.Range)
    Dim InputVal As String
    Dim R As Variant
    Dim Counter As Integer
    Dim NewVal As Variant
    Dim C As Integer
    Dim KeyCol As New Collection
    Dim Key As String
    Dim KeyArr As Variant
    Dim TransArr As Variant
    Dim i As Long
    Dim KeyError As Boolean
    InputVal = Range("D1").Value2
    R = SourceRng
    For Counter = LBound(R) To UBound(R)
        Key = R(Counter, 1)
        On Error Resume Next
        i = KeyCol(Key)
        KeyError = (Err <> 0)
        On Error GoTo 0
        If KeyError Then
            If Not IsArray(KeyArr) Then
                i = 0
                ReDim KeyArr(0 To 1, i)
            Else
                i = UBound(KeyArr, 2) + 1
                ReDim Preserve KeyArr(0 To 1, i)
            End If
            Dim KeyVals As Variant
            KeyArr(0, i) = Key
            KeyArr(1, i) = KeyVals
            KeyCol.Add i, Key
        End If
        NewVal = KeyArr(1, i)
        If Not IsArray(NewVal) Then
            C = 1
            ReDim NewVal(1 To C)
        Else
            C = UBound(NewVal) + 1
            ReDim Preserve NewVal(1 To C)
        End If
        NewVal(C) = R(Counter, 2)
        KeyArr(1, i) = NewVal
    Next Counter
    ReDim TransArr(UBound(KeyArr, 2), 1)
    For i = 0 To UBound(KeyArr, 2)
        TransArr(i, 0) = KeyArr(0, i)
        TransArr(i, 1) = Join(KeyArr(1, i), ",")
    Next
    TargetCell.Resize(UBound(TransArr, 1) + 1, UBound(TransArr, 2) + 1).Value2 = TransArr
End Sub

Called like this:

Public Sub DoAll_Click()
    JoinCodeTable Range("A1").CurrentRegion, Range("D3")
End Sub

Illustration:
ConcatCodes.jpg

Having re-read your question, why not simply?:

    Dim InputVal As String
    Dim R As Variant
    Dim Counter As Long
    Dim temp As String
    
    InputVal = Range("D1").Value2

    R = Range("A1").CurrentRegion.Value2

    
    For Counter = LBound(R) To UBound(R)
        If R(Counter, 1) = InputVal Then temp = temp & R(Counter, 2) & ","
    Next Counter

    Range("E1").Value2 = InputVal & " " & Left$(temp, Len(temp) - 1)

benchtests.xlsm

I reconfigured your original code into a benchmarkable format, and ran it 300 000 times x 5 separate runs, and got these times in seconds:
1.652344, 1.664063, 1.640625, 1.640625, 1.632813
That's pretty fast, told you so.

But we are optimizing, so I tested the following changes:

• Changed NewVal to string array
• Dimensioned it only once, to the maximum number of codes possible (ie. # of rows in source table)
• Only do one Redim Preserve at the end (just to get it to the right length for the Join function).

Again, I ran it 300 000 times x 5 separate runs, and got these times in seconds:
1.375, 1.378906, 1.40625, 1.394531, 1.433594

I also tested your last Dictionary based Sub, I ran it 300 000 times x 2 separate runs, and got these times in seconds:
25.30469, 27.78906

Sorry Trevor, missed that

@Kyle123

Shucks, I missed that in the Dictionary version; I added that one just before making my post. But that is the only one populating R in the loop.

But for the first two, the difference in array initialization is deliberate. That's the optimization - the design of Conc2 does not require that the array/dictionary be initialized for every distinct calculation. The same array just gets reused.

If I was optimizing one of my apps, that would be a significant consideration. One setup, many batches. If you were instantiating a class, you initialize the class instance, then use its methods. I usually don't care much whether the setup is optimized or not; it's usually a tiny fraction of total run time.

Basic rule of optimisation: Remove unnecessary operations from your inner loops.

It depends on how much data you have. At some point it becomes more efficient to sort and binary search rather than simply loop the data

True. I have been thinking about a recursive binary attack, but I would avoid sorting.

Why would you do a binary search without sorting?

Not quite a binary search. I'm attempting it now, better to post than explain.

Ok, that was interesting. The recursive, divide and conquer method. Not very fast though.

Option Explicit

Sub BranchTest()
    Dim R As Variant
    R = Range("A1:B16")
    Range("E2").Value2 = RecurseConcat(R, "XXX0001", LBound(R, 1), UBound(R, 1))
End Sub

Private Function RecurseConcat(ByVal R As Variant, ByVal InputVal As String, ByVal R1 As Long, ByVal R2 As Long, Optional Codes As String = "#INIT#") As String
    Dim R0 As Long
    Dim Str As String
    Dim First As Boolean
    If Codes = "#INIT#" Then
        Codes = ""
        First = True
    End If
    If R1 = R2 Then
        If R(R1, 1) = InputVal Then
            Str = Codes & R(R1, 2)
        End If
    ElseIf (R2 - R1) = 1 Then
        Str = RecurseConcat(R, InputVal, R1, R1, Codes)
        Str = Str & RecurseConcat(R, InputVal, R2, R2, Codes)
    Else
        R0 = Int(((R2 - 1) - R1 + 1) * Rnd + R1)
        Str = RecurseConcat(R, InputVal, R1, R0, Codes)
        Str = Str & RecurseConcat(R, InputVal, R0 + 1, R2, Codes)
    End If
    If First Then
        Str = InputVal & " " & Mid(Replace(Str, "E", ",E"), 2) 'cheating I know
    End If
    RecurseConcat = Str
End Function

This is a similar technique to Quicksort if memory serves. But where Quicksort's goal is to sort, ours is to collect codes. Turns out this is a silly way to do it, but I'm glad I've tested it. Sometimes a different approach has an unexpected performance payoff, especially when recursion's involved.

That's very over engineered imo. Taking this back to the original question, there are two things to consider in improving the algorithm. The string method is the fastest, but there are 2 obvious ways to improve it depending on circumstance and how far you'd need to take it.

1. If you need to look up multiple indexes at once, there comes a point where it's worth sorting the indexes. This allows for faster searching (binary), you don't need to iterate all the elements to get the full result. The catch is that the sorting takes time so is likely only worth it if you have a large amount of data and need to do multiple lookups.

2. String building in vba/vb6 is inneficient since the string is recreated in its entirety on each operation, you can google string building class vb6 for a lower level more efficient implementation. Again for short strings the difference just won't be worth the effort, so this is really only worth doing if you expect the result string to be made up of a huge number of elements

In summary, as tms said, you're unlikely to get any faster than looking up and buding the string whilst looping through. Whether it's worth the effort improving the algorithm very much depends on the circumstances, but unless you have a huge amount of data, I really wouldn't bother.

To put this into context, with the sample data, the string building method executes 300,000 iterations in a third of a second.

Yep, that's what I also concluded from my practical experiment. Although perfect, I don't consider 20/20 hindsight as a useful skill in developing innovative solutions.