Merge multiple groups of adjacent cells, which are separated by a blank cell, into respective single cells.

[NateZona]

Dear fine people of Mr. Excel,

I am not sure if this has a possible solution, but here is my problem...

I have a pdf with a large list of hyperlinks which have a text description attached to them. I tried many different ways of copy and paste to get them formatted correctly in excel to no avail.
However, I was able to separate them into groups of cells with a blank cell in between. Some groups are three cells, some are two cells.

Here is an example of what I mean...

Data1a

Data1b

Data1c

Data2a

Data2b

Data3a

Data3b

Data3c

Data4a

Data4b

Data5a

Data5b

Data6a

Data6b

<tbody>
</tbody>

What I would like to do is be able to combine each group into one cell respectively (i.e., "Data1a-c" in one cell, and "Data2a-b" in one cell, etc) using a macro on the whole sheet.


I have so many of these groups that it will take far too long to manually combine them one by one.

Thank you for your time, and I hope to hear from you soon!

Warm Regards,
Nate Zona

 

[hiker95]

NateZona,

1. What version of Excel, and, Windows are you using?

2. Are you using a PC or a Mac?


I was not sure about what the results should look like. If the following is not correct, then I can adjust the macro.

Sample raw data, and, results:

Excel 2007
	A	B	C
1	Data1a		Data1a, Data1b, Data1c
2	Data1b		Data2a, Data2b
3	Data1c		Data3a, Data3b, Data3c
4			Data4a, Data4b
5	Data2a		Data5a, Data5b
6	Data2b		Data6a, Data6b
7
8	Data3a
9	Data3b
10	Data3c
11
12	Data4a
13	Data4b
14
15	Data5a
16	Data5b
17
18	Data6a
19	Data6b
20
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).

Sub ReorgDataGroups()
' hiker95, 12/19/2015, ME909774
Dim o As Variant, j As Long
Dim Area As Range, s As String
Dim lr As Long, sr As Long, er As Long
Application.ScreenUpdating = False
s = ", "
lr = Cells(Rows.Count, 1).End(xlUp).Row
ReDim o(1 To lr, 1 To 1)
For Each Area In Range("A1:A" & lr).SpecialCells(xlCellTypeConstants).Areas
  With Area
    sr = .Row
    er = sr + .Rows.Count - 1
    j = j + 1
    o(j, 1) = Join(Application.Transpose(Range("A" & sr & ":A" & er)), s)
  End With
Next Area
Range("C1").Resize(UBound(o, 1), UBound(o, 2)) = o
Columns(3).AutoFit
Application.ScreenUpdating = True
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, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ReorgDataGroups macro.

 

[hiker95]

NateZona,

Here is an updated macro for you to consider.

Sample raw data, and, new results:

Excel 2007
	A	B	C
1	Data1a		Data1a-c
2	Data1b		Data2a-b
3	Data1c		Data3a-c
4			Data4a-b
5	Data2a		Data5a-b
6	Data2b		Data6a-b
7
8	Data3a
9	Data3b
10	Data3c
11
12	Data4a
13	Data4b
14
15	Data5a
16	Data5b
17
18	Data6a
19	Data6b
20
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).

Sub ReorgDataGroups_V2()
' hiker95, 12/19/2015, ME909774
Dim o As Variant, j As Long
Dim Area As Range, s As String
Dim lr As Long, sr As Long, er As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
ReDim o(1 To lr, 1 To 1)
For Each Area In Range("A1:A" & lr).SpecialCells(xlCellTypeConstants).Areas
  With Area
    sr = .Row
    er = sr + .Rows.Count - 1
    If .Rows.Count = 1 Then
      j = j + 1
      o(j, 1) = .Range("A" & sr)
    Else
      j = j + 1
      s = ""
      s = s & Range("A" & sr) & "-"
      s = s & Right(Range("A" & er), 1)
      o(j, 1) = s
    End If
  End With
Next Area
Range("C1").Resize(UBound(o, 1), UBound(o, 2)) = o
Columns(3).AutoFit
Application.ScreenUpdating = True
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, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ReorgDataGroups_V2 macro.

 

[Peter_SSs]

.. and another one. Mine assumes data starts in cell A2. Adjust A2 to A1 (& possibly B2 to B1) in the code if that suits better.

Sub CombineThem()
  Range("B2").Resize(Columns("A").SpecialCells(xlConstants).Areas.Count).Value = _
    Application.Transpose(Split(Join(Application.Transpose(Range("A2", Range("A" & Rows.Count).End(xlUp)).Value), ", "), ", , "))
End Sub

Original data In Col A, results in Col B

Excel Workbook
	A	B
1
2	Data1a	Data1a, Data1b, Data1c
3	Data1b	Data2a, Data2b
4	Data1c	Data3a, Data3b, Data3c
5		Data4a, Data4b
6	Data2a	Data5a, Data5b
7	Data2b	Data6a, Data6b
8
9	Data3a
10	Data3b
11	Data3c
12
13	Data4a
14	Data4b
15
16	Data5a
17	Data5b
18
19	Data6a
20	Data6b
21
Sheet1

 

[NateZona]

Thank you so much this works perfectly!!

You rock!

 

[NateZona]

[h=2]

Re: Merge multiple groups of adjacent cells, which are separated by a blank cell, into respective single cells.[/h]

.. and another one. Mine assumes data starts in cell A2. Adjust A2 to A1 (& possibly B2 to B1) in the code if that suits better.
Code:
Sub CombineThem()
Range("B2").Resize(Columns("A").SpecialCells(xlConstants).Areas.Count).Value = _
Application.Transpose(Split(Join(Application.Transpose(Range("A2", Range("A" & Rows.Count).End(xlUp)).Value), ", "), ", , "))
End Sub
Original data In Col A, results in Col B

Sheet1

	A	B
1
2	Data1a	Data1a, Data1b, Data1c
3	Data1b	Data2a, Data2b
4	Data1c	Data3a, Data3b, Data3c
5		Data4a, Data4b
6	Data2a	Data5a, Data5b
7	Data2b	Data6a, Data6b
8
9	Data3a
10	Data3b
11	Data3c
12
13	Data4a
14	Data4b
15
16	Data5a
17	Data5b
18
19	Data6a
20	Data6b
21

<colgroup><col style="font-weight: bold; width: 30px;"><col style="width: 68px;"><col style="width: 171px;"></colgroup><tbody>
</tbody>

Thank you so much this works perfectly!!

You rock!

 

[Peter_SSs]

Thank you so much this works perfectly!!

You rock!

Glad you got a successful outcome. Thanks for letting us know.

 

[hiker95]

NateZona,

I was wondering if you even tried either of my two macros from my replies #2, or, #3?

 

[NateZona]

I did, but they did not work correctly. Thank you though.

 

[hiker95]

I did, but they did not work correctly. Thank you though.

NateZona,

You are welcome.

In the future when asking for help I would suggest that you provide a screenshot of the actual raw data, and, what the results should look like, as you did in your reply #6.