Concatenate every 100 rows into one cell with VBA

[satish78]

Hi Friends,

Trying to concatenate every 100 rows into one cell
=Concatenate(C1:C100)
=Concatenate(C101:C200)
=Concatenate(C201:C300) and so on.
I have 50K rows to concatenate/combine cells

Above formula is not working. I know that VBA macro can do this task. Every time I have to specific number of rows to combine. For example, sometimes every 9 rows or every 500 or 1000 rows to combine.
It would be great if a macro ask me to specify every number of rows to combine.

Hope you understand.

 

[Fluff]

How about

Sub ConcatData()

    Dim Ans As String
    Dim Cnt As Long
    Dim Cl As Range
    Dim Rw As Long
    
    Ans = InputBox("How many rows do you want to use?")
    If Len(Ans) = 0 Then Exit Sub
    Rw = 1
    For Cnt = 1 To Range("C" & Rows.Count).End(xlUp).row Step Ans
        For Each Cl In Range("C" & Cnt).Resize(Ans)
            If Range("A" & Rw).Value = "" Then
                Range("A" & Rw).Value = Cl
            Else
                Range("A" & Rw).Value = Range("A" & Rw).Value & "," & Cl.Value
            End If
        Next Cl
        Rw = Rw + 1
    Next Cnt

End Sub

This will put the concatenated strings in A1 downwards

 

[Rick Rothstein]

How about

Sub ConcatData()

    Dim Ans As String
    Dim Cnt As Long
    Dim Cl As Range
    Dim Rw As Long
    
    Ans = InputBox("How many rows do you want to use?")
    If Len(Ans) = 0 Then Exit Sub
    Rw = 1
    For Cnt = 1 To Range("C" & Rows.Count).End(xlUp).row Step Ans
        For Each Cl In Range("C" & Cnt).Resize(Ans)
            If Range("A" & Rw).Value = "" Then
                Range("A" & Rw).Value = Cl
            Else
                Range("A" & Rw).Value = Range("A" & Rw).Value & "," & Cl.Value
            End If
        Next Cl
        Rw = Rw + 1
    Next Cnt

End Sub

This will put the concatenated strings in A1 downwards

The following somewhat more compact macro will produce the same output as your code does...

[table="width: 500"]
[tr]
	[td]Sub ConcatData()

    Dim R As Long, Ans As String, Txt As String
    
    Ans = InputBox("How many rows do you want to use?")
    For R = 1 To Cells(Rows.Count, "C").End(xlUp).Row Step Ans
      Range("A1").Offset(Int((R - 1) / Ans)) = Join(Application.Transpose(Cells(R, "C").Resize(Ans)), ",")
    Next
    
End Sub[/td]
[/tr]
[/table]

However, I note that if the list in Column C is not an exact multiple of the number inputted by the user, both of our codes will put a trail of consecutive commas at the end of the text in the last data cell outputted to Column A. The following revision to my macro will eliminate those trailing commas, but for it to work correctly, none of the cells internal to the values in Column C can be blank.

[table="width: 500"]
[tr]
	[td]Sub ConcatData()

    Dim R As Long, Ans As String, Txt As String
    
    Ans = InputBox("How many rows do you want to use?")
    For R = 1 To Cells(Rows.Count, "C").End(xlUp).Row Step Ans
      Txt = Join(Application.Transpose(Cells(R, "C").Resize(Ans)), ",")
      Range("A1").Offset(Int((R - 1) / Ans)) = Left(Txt, InStr(Txt & ",,", ",,") - 1)
    Next
    
End Sub[/td]
[/tr]
[/table]

 

[Fennek]

Hello,

a bit late:

sub Untested()
for i = 1 to cells(rows.count, 3).end(xlup).row step 100
r=r+1
cells(r,4) = join(application.transpose(range("C" & i & ":C" & i+99)), ", ")
next i
end sub

regards

 

[satish78]

Hi Rick,

Your last macro did the magic what I want and also popup box where I have an opportunity to specify the number whatever I need.
"," is an added advantage.

Thanks Rick you saved my time.
Sub ConcatData()

Dim R As Long, Ans As String, Txt As String

Ans = InputBox("How many rows do you want to use?")
For R = 1 To Cells(Rows.Count, "C").End(xlUp).Row Step Ans
Txt = Join(Application.Transpose(Cells(R, "C").Resize(Ans)), ",")
Range("A1").Offset(Int((R - 1) / Ans)) = Left(Txt, InStr(Txt & ",,", ",,") - 1)
Next

End Sub

 

[satish78]

Fluff

You macro code taking much time to output the results.