VBA Combine every N cells into one cell and the cell below

[benpagoza]

Good day!
I would like to create a loop in VBA that would copy every two rows to a cell below.
__________________________________
i.e. copy row a1 and a2 to b1
copy row a3 and a4 to b2
copy row a5 and a6 to b3
etc...
until end of row
__________________________________

So far this is what I found in my google search.
Sub Concatenate_Cells()
Dim i As Long
Dim Lastrow As String
Dim TotalStrings As String
Dim first10row As String

Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To Lastrow
TotalStrings = TotalStrings & Cells(i, 1) & ","
Next i

TotalStrings = Left(TotalStrings, Len(TotalStrings) - 1)

Range("lastcell") = TotalStrings
End Sub

 

[hiker95]

benpagoza,

Welcome to the MrExcel forum.

Sample raw data:

Excel 2007
	A	B
1	one
2	two
3	three
4	four
5	five
6	six
7	seven
8	eitht
9	nine
10	ten
11	eleven
12	twelve
13	thirteen
14
Sheet1

After the macro:

Excel 2007
	A	B
1	one	one,two
2	two	three,four
3	three	five,six
4	four	seven,eitht
5	five	nine,ten
6	six	eleven,twelve
7	seven	thirteen
8	eitht
9	nine
10	ten
11	eleven
12	twelve
13	thirteen
14
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub ReorgData()
' hiker95, 03/26/2013
' http://www.mrexcel.com/forum/excel-questions/693714-visual-basic-applications-combine-every-n-cells-into-one-cell-cell-below.html
Dim r As Long, lr As Long, nr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = 1 To lr Step 2
  nr = nr + 1
  Cells(nr, 2) = Cells(r, 1) & "," & Cells(r + 1, 1)
  If Right(Cells(nr, 2), 1) = "," Then
    Cells(nr, 2) = Left(Cells(nr, 2), Len(Cells(nr, 2)) - 1)
  End If
Next r
Columns(2).AutoFit
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.

 

[benpagoza]

Thank you very much for your help Hiker95

This macro worked!

 

[hiker95]

benpagoza,

You are very welcome. Glad I could help.

Thanks for the feedback.

Come back anytime.

 

[Rick Rothstein]

Here is another macro which uses a completely different technique that should also work for you...

Sub ReorganizeData()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("B1:B" & LastRow) = Evaluate("IF(MOD(ROW(A1:A" & LastRow & "),2),A1:A" & _
                            LastRow & "&"",""&A2:A" & LastRow + 1 & ","""")")
  Range("B1:B" & LastRow).SpecialCells(xlBlanks).Delete xlUp
  With Cells(Rows.Count, "B").End(xlUp)
    If Right(.Value, 1) = "," Then .Value = Replace(.Value, ",", "")
  End With
End Sub

 

[Rajesh1]

Hi,

I also have a similar requirement to join every 20 rows in excel. Example data is as below. Can you please help me with the same.

Thanks in Advance.

Values	Result
1	1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
2	21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

<colgroup><col style="width: 37pt; mso-width-source: userset; mso-width-alt: 1792;" width="49"> <col style="width: 622pt; mso-width-source: userset; mso-width-alt: 30317;" width="829"> <tbody>
</tbody>

 

[Rick Rothstein]

I also have a similar requirement to join every 20 rows in excel. Example data is as below. Can you please help me with the same.

Give this macro a try...

Sub ReorganizeData()
  Dim X As Long, LastRow As Long, Index As Long
  Const Interval As Long = 20
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For X = 1 To LastRow Step Interval
    Index = Index + 1
    Cells(Index, "B") = Application.Trim(Join(Application.Transpose(Cells(X, "A").Resize(Interval).Value), " "))
  Next
End Sub

 

[Rajesh1]

Thank you so much for the quick response. It works as required.

 

[afeldsh]

Hello,

I was wondering if you can help me out as well.

I have a report that generates multiple results for a given part number. Column B is the P/N, Column C are the results. Currently it puts the results into separate cells. After I generate this report, I am looking to combine results into a single cell of column C, each result separated with a new line. Is it possible to write a macro for this? Any help is greatly appreciated.

Current report:

	P/N	Result
	123	Result 1
		Result 2
		Result 3
	124	Result 1
		Result 2
	125	Result 1
		Result 2
		Result 3
		Result 4
		Result 5
		Result 6
		Result 7
		Result 8
	127	Result 1

<tbody>
</tbody>

I would like it to be:

	P/N	Result
	123	Result 1 Result 2 Result 3
	124	Result 1 Result 2
	125	Result 1 Result 2 Result 3 Result 4 Result 5 Result 6 Result 7 Result 8
	127	Result 1

<tbody>
</tbody>

 

[Rick Rothstein]

I have a report that generates multiple results for a given part number. Column B is the P/N, Column C are the results. Currently it puts the results into separate cells. After I generate this report, I am looking to combine results into a single cell of column C, each result separated with a new line. Is it possible to write a macro for this?

Since the P/N and Results are in Columns B and C, I presume you have other data in other columns (at in Column A for sure). What should happen with the data in these other columns? Using the 123 P/N, it has three results in C2:C4... once processed, cell C2 will contain the data... what should happen to cells C3:C4 (now that their information has been moved into cell C2? Should just those cell be made blank? Should the entire row those cells are on be deleted and all data under them moved up to fill the gap? Something else?