3
\$\begingroup\$

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
\$\endgroup\$
3
\$\begingroup\$

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:

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:

enter image description here

| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ Wow, thank you. This definitely speeds up the process and gives me a lot to dig into. I've heard that arrays > ranges in VBA but this is my first time seeing why. \$\endgroup\$ – Ves Apr 7 '17 at 18:42
  • \$\begingroup\$ Only one thing still not working — since the LoopRange is dynamic, it could contain three values (AAA/BBB/CCC in the example) but it could also contain two or twelve. When the LoopRange contains fewer than three values, the code you provided throws the 'Subscript out of range' error, and when the LoopRange contains more than three values only the first three are included in the output. Not sure what the solution is — it looks like this part is handled in the function but I'm not having any luck trying to modify it. \$\endgroup\$ – Ves Apr 7 '17 at 18:43
  • \$\begingroup\$ Change the line that says If j > 3 Then to If j > UBound(loopData, 1) Then. That works because your index limit is now set by the size of the data. \$\endgroup\$ – PeterT Apr 7 '17 at 18:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.