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:
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.
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