Concatenate multiple ranges using vba

Question

I have a number of ranges to concatenate independently and put the values of the concatenated ranges into different cells.

I want to:
concatenate values in Range A1:A10 and put the result in F1
then concatenate the Range B1:B10 and put the result in F2
then concatenate the Range C1:C10 and put the result in F3 etc.

The following macro concatenates range A1:A10 and then puts the results into F1 (which is what I want). However it also stores the information from the first concatenation into memory so that when it does the next concatenation, in cell F2 I get the concatenated results of F1 and F2 joined.

Sub concatenate()

    Dim x As String
    Dim Y As String

For m = 2 To 5

    Y = Worksheets("Variables").Cells(m, 5).Value 

    'Above essentially has the range information e.g. a1:a10 in sheet variables

    For Each Cell In Range("" & Y & "") 'i.e. range A1:A10
        If Cell.Value = "" Then GoTo Line1 'this tells the macro to continue until a blank cell is reached
        x = x & Cell.Value & "," 'this provides the concatenated cell value
    Next

Line1:

    ActiveCell.Value = x

    ActiveCell.Offset(1, 0).Select

Next m

End Sub

Answer 1

Here is my ConcatenateRange. It allows you to add a seperator if you please. It is optimized to handle large ranges since it works by dumping the data in a variant array and working with it within VBA.

You would use it like this:

=ConcatenateRange(A1:A10)

The code:

Function ConcatenateRange(ByVal cell_range As range, _
                    Optional ByVal seperator As String) As String

Dim newString As String
Dim cellArray As Variant
Dim i As Long, j As Long

cellArray = cell_range.Value

For i = 1 To UBound(cellArray, 1)
    For j = 1 To UBound(cellArray, 2)
        If Len(cellArray(i, j)) <> 0 Then
            newString = newString & (seperator & cellArray(i, j))
        End If
    Next
Next

If Len(newString) <> 0 Then
    newString = Right$(newString, (Len(newString) - Len(seperator)))
End If

ConcatenateRange = newString

End Function