VB/VBA Fast String Concatenate Class

aikimarkGet vaccinated; Social distance; Wear a mask
CERTIFIED EXPERT
Published:

Introduction

In a recent article for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no one had written an EE article on a general purpose fast concatenation function for VB and VBA developers.  The VB.Net community enjoys the StringBuilder class and that (fast concatenation) is a missing functionality for the VB/VBA developer.

If you are interested in the different performance characteristics of the intrinsic VB concatenation operators (& and +) and alternatives, please look at the prior article's attached VB project files and performance summaries.

There are several different development environments in which to create and consume this functionality.  I will use an Office 2003 environment for these examples.

Designing Our Class

Let's put on our OOP goggles for a moment and talk about our design.  We need to append strings to our object and retrieve the concatenated string.  As a nice feature, let's provide the ability to insert some delimiter text between our concatenated strings.
We will need an ADD method that is passed a string.
We will need a TEXT property (read/write = set/get).
We will need a DELIMITER property (read/write = set/get).

We want our class to perform well, so we will add fast performance as decision criteria.

Creating Your Class Module

1. Add the module

Open your code window (Alt+F11)
Insert | Class Module

This will add a Class Modules node to your current project and add a Class# module, where # is a sequential number, starting with 1.

If you open the new module, you'll see that it only contains a General Declarations section.
Option Explicit

Open in new window


If you select Class in the left side drop down, you will see that there are two skeleton events for this (or any) class, Initialize and Terminate.  If you were to select both of these, your class would now contain this code:
Option Explicit
                      
                      Private Sub Class_Initialize()
                      
                      End Sub
                      
                      Private Sub Class_Terminate()
                      
                      End Sub

Open in new window


2. Add the Properties and Methods

We are going to use the Insert | Procedure menu three times.  The first two times, we are going to create a Property (Text and Delim).  The third time, we are going to create a Function (Add).

Add Text PropertyAdd Delim PropertyCreate Add Method
After these insert steps have completed, our class will now have these skeleton routines:
Public Property Get Text() As Variant
                      
                      End Property
                      
                      Public Property Let Text(ByVal vNewValue As Variant)
                      
                      End Property
                      
                      Public Property Get Delim() As Variant
                      
                      End Property
                      
                      Public Property Let Delim(ByVal vNewValue As Variant)
                      
                      End Property
                      
                      Public Function Add()
                      
                      End Function

Open in new window

3. Tweaking the Properties and Methods

These skeletons are a nice start, but we need to tweak them to get our desired and best results.  We will change the Variant data types to string, changing the parameter variable name, and add a parameter to the Add method/function.

Public Property Get Text() As String
                      
                      End Property
                      
                      Public Property Let Text(ByVal strNewValue As String)
                      
                      End Property
                      
                      Public Property Get Delim() As String
                      
                      End Property
                      
                      Public Property Let Delim(ByVal strNewValue As String)
                      
                      End Property
                      
                      Public Function Add(ByVal strNewValue As String)
                      
                      End Function

Open in new window

4. Add Private Class Variables

We will store data in private variables in the class's General Declarations section.  In this case, we need a collection object to hold the strings as they are added and we need to hold any delimiter string.

Option Explicit
                      Private colStrings As Collection
                      Private strDelim As String

Open in new window

5. Add Working Code to the Routines

We need to add code that will transfer data to/from our private variables.
The simplest is the Add function -- just add the string to our collection:
Public Function Add(ByVal strNewValue As String)
                          colStrings.Add strNewValue
                      End Function

Open in new window


The Delim property is the next simplest -- it stores and retrieves the strDelim private variable value.
Public Property Get Delim() As String
                          Delim = strDelim
                      End Property
                      
                      Public Property Let Delim(ByVal strNewValue As String)
                          strDelim = strNewValue
                      End Property

Open in new window


The Text property code is a bit more complicated.  Since we need to concatenate our appended string segments, we will get better performance if we store the concatenated string as the first, and only, item in our collection.  Likewise, we need to reset our collection and make the first, and only, item the supplied string if the invoking code assigns a value to the object's Text property.
Public Property Get Text() As String
                          Dim lngNext As Long
                          Dim strStrings() As String
                          Dim varItem As Variant
                          Dim strText As String
                          
                          Select Case colStrings.Count
                              Case 0
                                  Text = vbNullString
                              Case 1
                                  Text = colStrings(1)
                              Case Else
                                  ReDim strStrings(1 To colStrings.Count)
                                  For Each varItem In colStrings
                                      lngNext = lngNext + 1
                                      strStrings(lngNext) = varItem
                                  Next
                                  Set colStrings = Nothing
                                  Set colStrings = New Collection
                                  strText = Join(strStrings, strDelim)
                                  colStrings.Add strText
                                  Text = strText
                          End Select
                      End Property
                      
                      Public Property Let Text(ByVal strNewValue As String)
                          Set colStrings = Nothing
                          Set colStrings = New Collection
                          colStrings.Add strNewValue
                      End Property

Open in new window


Finally, we need to instantiate and remove the collection object when our class is created and destroyed.
Private Sub Class_Initialize()
                          Set colStrings = New Collection
                      End Sub
                      
                      Private Sub Class_Terminate()
                          Set colStrings = Nothing
                      End Sub

Open in new window


Using the BuildString Class

Add the following routine to a module.  We will instantiate the new class, append some 36 character strings to the class, and either print the length of the concatenated string or print the concatenated string to the Immediate window.
Public Sub testBuildString(ByVal parmIterations)
                          Dim lngLoop As Long
                          Const AtoZ As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                          Dim BS As New clsBuildString
                          For lngLoop = 1 To parmIterations
                              BS.Add AtoZ & Format(lngLoop, "0000000000")
                          Next
                          BS.Delim = vbCrLf
                          If Len(BS.Text) > 255 Then
                              Debug.Print "Length of concatenate string: " & Len(BS.Text)
                          Else
                              Debug.Print BS.Text
                          End If
                      End Sub

Open in new window


In the Immediate window, invoke the testBuildString routine, passing an iteration value.  In the following snippet from my test, I printed the iteration value along with the before and after values of the Timer.  The routine exhibited sub-second performance until we reached the 100k iteration value.
for each X in array(5,10,100,1000,10000,100000):?X,timer:testBuildString X:?X,timer:?:next
                       5             8625.439 
                      ABCDEFGHIJKLMNOPQRSTUVWXYZ0000000001
                      ABCDEFGHIJKLMNOPQRSTUVWXYZ0000000002
                      ABCDEFGHIJKLMNOPQRSTUVWXYZ0000000003
                      ABCDEFGHIJKLMNOPQRSTUVWXYZ0000000004
                      ABCDEFGHIJKLMNOPQRSTUVWXYZ0000000005
                       5             8625.452 
                      
                       10            8625.456 
                      Length of concatenate string: 378
                       10            8625.466 
                      
                       100           8625.47 
                      Length of concatenate string: 3798
                       100           8625.484 
                      
                       1000          8625.489 
                      Length of concatenate string: 37998
                       1000          8625.516 
                      
                       10000         8625.521 
                      Length of concatenate string: 379998
                       10000         8625.673 
                      
                       100000        8625.678 
                      Length of concatenate string: 3799998
                       100000        8626.904 

Open in new window


Addendum

Here is the class module that you can import into your VB/VBA project.
clsBuildString.cls

If you want the ability to concatenate the same string segments with different delimiters, you could use the Replace() function to change the delimiters in the concatenated string.  Alternatively, you could change the class to not reset the collection when the Text property is retrieved.  I leave it to you to add that new property and behavior to your class module as a programming exercise.

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
If you liked this article and want to see more from this author,
please click here.
If you found this article helpful, please click the Yes button near the:

      Was this article helpful?

label that is just below and to the right of this text.   Thanks!
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
7
10,194 Views
aikimarkGet vaccinated; Social distance; Wear a mask
CERTIFIED EXPERT

Comments (3)

Kevin CrossChief Technology Officer
CERTIFIED EXPERT
Most Valuable Expert 2011

Commented:
Very well written, Mark! You have my Yes vote above.
CERTIFIED EXPERT

Commented:
Mark,

I liked it as well on a quick read. I will look to set aside some time to look in detail

Cheers

Dave
aikimarkGet vaccinated; Social distance; Wear a mask
CERTIFIED EXPERT
Top Expert 2014

Author

Commented:
For future readers, I should have included a link to this matthewspatrick article on building classes.  It is most excellent.
http:/A_3802-Parent-Class-Builder-Add-In-for-Microsoft-Excel.html

Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.