Excel VBA script – concatenates multiple values using Loop

Question

I have an Excel VBA script that concatenates five values: three static text strings, and values contained in two dynamic user-input ranges. One of the ranges contains values that need to be concatenated repeatedly in the output, top to bottom, over and over, until the end of the data in the other range is reached.

So, given sample values:

TextA: Alpha
TextB: Gamma
TextC: Delta

LoopRange:

AAA
BBB
CCC

UserRange:

111
222
333
444
555
666
777
888

The output should be:

AlphaAAAGamma111Delta AlphaBBBGamma222Delta AlphaCCCGamma333Delta AlphaAAAGamma444Delta AlphaBBBGamma555Delta AlphaCCCGamma666Delta AlphaAAAGamma777Delta AlphaBBBGamma888Delta 

The script I've written works, but in a rather janky way. It builds the output in stages — creating a new column of data, combining it with existing values, combining those results with remaining values until the output is achieved, then deleting the leftovers.

The enhancement I'm looking for is how to avoid the piecemeal process currently in place. I'm thinking there's a way to nest the Loop inside a For statement but I haven't been able to figure it out.

Sample of the worksheet

Sub LoopAndConcat() Application.ScreenUpdating = False Application.DisplayAlerts = False Dim TextA As String Dim TextB As String Dim TextC As String Dim LoopRange As Range Dim CellA As Long Dim CopyRange As Range Dim CellB As Range Dim LastRow As Long Dim CellC As Long TextA = ActiveSheet.Cells(3, "A").Value TextB = ActiveSheet.Cells(6, "A").Value TextC = ActiveSheet.Cells(9, "A").Value Set LoopRange = Range(ActiveSheet.Cells(12, "A"), ActiveSheet.Cells(Rows.Count, "A").End(xlUp)) Do CellA = CellA + 1 LoopRange.Copy Range("E" & Rows.Count).End(xlUp)(2) Loop Until CellA = 10 Set CopyRange = Range(ActiveSheet.Cells(2, "E"), ActiveSheet.Cells(Rows.Count, "E").End(xlUp)) For Each CellB In CopyRange If Not CellB.Offset(0, -3).Value = "" Then CellB.Offset(0, -2).Value = TextA & CellB.Value & TextB End If Next CellB LastRow = Range("B" & Rows.Count).End(xlUp).Row For CellC = 2 To LastRow ActiveSheet.Cells(CellC, "C").Value = ActiveSheet.Cells(CellC, "C").Value & _ ActiveSheet.Cells(CellC, "B").Value & _ TextC Next CellC CopyRange.ClearContents Application.ScreenUpdating = True Application.DisplayAlerts = True If Not LoopRange Is Nothing Then Set LoopRange = Nothing If Not CopyRange Is Nothing Then Set CopyRange = Nothing End Sub 

Answer 1

The approach I took to your problem led me to separate it into two stages: the first determine the locations of the source data and the second processes the data to perform the concatenation.

Initially capturing your source data, I used the following data setup:

A few things to note:

1. Always use Option Explicit for the reasons listed there
2. Always define and set references to all Workbooks and Sheets
3. Work with Arrays, Not With Ranges

And so, based on those concepts, the setup method looked like this:

Option Explicit Sub DataSetup() Dim wb As Workbook Set wb = ThisWorkbook Dim ws As Worksheet Set ws = wb.Sheets("Sheet1") Dim staticText(1 To 3) As String staticText(1) = ws.Range("A2") staticText(2) = ws.Range("A3") staticText(3) = ws.Range("A4") Dim startRow As Long Dim lastRow As Long Dim loopRange As Range startRow = 4 lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row Set loopRange = ws.Cells(startRow, "C").Resize(lastRow - startRow + 1, 1) Dim userRange As Range startRow = 3 lastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row Set userRange = ws.Cells(startRow, "E").Resize(lastRow - startRow + 1, 1) Dim results As Variant results = LoopAndConcat(staticText, loopRange, userRange) Dim resultsRange As Range Set resultsRange = ws.Range("G2").Resize(UBound(results, 1), 1) resultsRange = Application.Transpose(results) End Sub 

You may notice that I didn't pass arrays to the LoopAndConcat function. We only really need that data as an array inside the function, no where else.

Inside the work of the concatenating function, I took advantage of the fact that your static data is limited to three strings. Because of this, you can do all the work in a single loop. Working from arrays and storing the results in an array makes this function very fast. The resulting array of data can be located anywhere in the workbook you need it, the function doesn't need to care where those results end up.

Function LoopAndConcat(fixedText() As String, _ loopArea As Range, _ userArea As Range) As Variant '--- for speed, copy the data to memory arrays ' (expected Range is "n" rows by one column) Dim loopData As Variant Dim userData As Variant loopData = loopArea userData = userArea '--- establish results array, properly sized Dim results() As Variant ReDim results(1 To UBound(userData, 1)) As Variant Dim finalText As String Dim i As Long Dim j As Long j = 1 For i = 1 To UBound(userData, 1) finalText = fixedText(1) & loopData(j, 1) & _ fixedText(2) & userData(i, 1) & _ fixedText(3) results(i) = finalText j = j + 1 If j > 3 Then j = 1 End If Next i LoopAndConcat = results End Function 

My results: