Transposing Ranges of 20...

[Lluneta]

Hi all
I’m trying to do following with a Macro:
I have Column A filled with data (the number of rows changes every time).
I want to put together the content of Column A in groups of 20 in Column B and add some text before. It’s working with the following macro but there is a problem. For the last row with data in column B it adds a space behind for each empty cell it finds until 20. Does anyone how to avoid that?

Sub split_into_ groups()
For j = 1 To Range("A").End(xlUp).Row Step 20
Sheets("Sheet1").Cells(j, 2) = “My text” & Join(Application.Transpose(Sheets("Sheet1").Cells(j, 1).Resize(20)))
Next
End Sub


Thanks!

 

[VoG]

Try

Sub split_into_groups()
For j = 1 To Range("A").End(xlUp).Row - 19 Step 20
    Sheets("Sheet1").Cells(j, 2) = "My text" & Join(Application.Transpose(Sheets("Sheet1").Cells(j, 1).Resize(20)))
Next
End Sub

 

[Lluneta]

Thanks VOG,

However, this is not working. It returns an error msg.

 

[VoG]

Try

Sub split_into_groups()
For j = 1 To Range("A" & Rows.Count).End(xlUp).Row - 19 Step 20
    Sheets("Sheet1").Cells(j, 2) = "My text" & Join(Application.Transpose(Sheets("Sheet1").Cells(j, 1).Resize(20)))
Next
End Sub

 

[Lluneta]

Umm, thanks again, VOG!

With the new macro, it skips to add the info in Column B for the last loop...

 

[VoG]

It worked for me when I tested with 60 rows in column A. Wouldn't it be better to have the output in consecutive rows in column B:

Sub split_into_groups()
Dim i As Long, j As Long
For j = 1 To Range("A" & Rows.Count).End(xlUp).Row - 19 Step 20
    i = i + 1
    Sheets("Sheet1").Cells(i, 2) = "My text" & Join(Application.Transpose(Sheets("Sheet1").Cells(j, 1).Resize(20)))
Next j
End Sub

 

[Lluneta]

Wow, that's an amazing progress. But still, same problem.

I guess the problem appears when the number of rows is not 20, 40, 60... Lets say I have 65.
I become a result for 1-20, 20-40 and 40-60, but it misses the 61-65.

 

[VoG]

Try this

Sub split_into_groups()
Dim i As Long, j As Long, LR As Long, NR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
NR = WorksheetFunction.Ceiling(LR, 20)
For j = 1 To NR - LR Mod 20 Step 20
    i = i + 1
    Sheets("Sheet1").Cells(i, 2) = "My text" & Join(Application.Transpose(Sheets("Sheet1").Cells(j, 1).Resize(20)))
Next j
End Sub

 

[Lluneta]

There is still the same problem. A lots of spaces added in the last Row of column B.
I'm thinking now to run another macro to remove all the blank spaces at the end of the string for Column B (I need to remove the last word anyways of each string). That would solve the problem.

 

[VoG]

I don't get those spaces. Maybe you have spaces in the cells at the end of column A. Anyway, try

Sub split_into_groups()
Dim i As Long, j As Long, LR As Long, NR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
NR = WorksheetFunction.Ceiling(LR, 20)
For j = 1 To NR - LR Mod 20 Step 20
    i = i + 1
    Sheets("Sheet1").Cells(i, 2) = "My text" & Trim(Join(Application.Transpose(Sheets("Sheet1").Cells(j, 1).Resize(20))))
Next j
End Sub