Merge Rows Using Column One Values

Question

I would like to merge rows based on Column 1 values of my data set.

ℹ Sample data is pasted below.

E.g. I select the range from A1:D20 and run the macro.

See After Merge screenshot:

Need to autofit row height,

no border required for the selected range. I added for the merged rows to stand out.

Before Merge:

After Merge:

Sample data to copy into your workbook.

453564 4926	453564	AMZ CM PCD	Name One	TNB	5455-66
453564 4926	453564	AMZ CM PCD	Name One	HGT	3343-5
453564 4926	453564	AMZ CM PCD	Name One	VVF	434-67
453564 210254	453564	AMZ CM PCD	Name Two	TNB	5455-66
453564 210254	453564	AMZ CM PCD	Name Two	HGT	3343-5
453564 210254	453564	AMZ CM PCD	Name Two	VVF	434-67
45356450 20243	45356450	Reusable Temp	Name Three	GST	223-5
45356450 20243	45356450	Reusable Temp	Name Three	VDDDR	888-55
564703941 1024926	564703941	CHL-VS for VSa	Name One	TNB	5455-66
564703941 1024926	564703941	CHL-VS for VSa	Name One	HGT	3343-5
564703941 1024926	564703941	CHL-VS for VSa	Name One	VVF	434-67
564703941 1025470	564703941	CHL-VS for VSa	Name Two	TNB	5455-66
564703941 1025470	564703941	CHL-VS for VSa	Name Two	HGT	3343-5
564703941 1025470	564703941	CHL-VS for VSa	Name Two	VVF	434-67
3564801131 1024926	3564801131	CHL-VI 20 IO	Name One	TNB	5455-66
3564801131 1024926	3564801131	CHL-VI 20 IO	Name One	HGT	3343-5
3564801131 1024926	3564801131	CHL-VI 20 IO	Name One	VVF	434-67
3564801131 1025470	3564801131	CHL-VI 20 IO	Name Two	TNB	5455-66
3564801131 1025470	3564801131	CHL-VI 20 IO	Name Two	HGT	3343-5
3564801131 1025470	3564801131	CHL-VI 20 IO	Name Two	VVF	434-67

Answer 1

Dear ExcelFunTension:

Good day! Thank you for posting to Microsoft Community. We are happy to help you.

To achieve your needs, we can use VBA or manually do this.

We would love to help you on your query about VBA code, however, our team focuses on general query, for example, installation and activation issue of Office 365 products. The situation you mentioned is related to VBA code, you can to refer to this article: Office VBA support and feedback | Microsoft Docs to go to Stack Overflow by using the VBA tag, along with any other relevant tags as there are also many experienced engineers and experts in the forums there.

Disclaimer: Microsoft provides no assurances and/or warranties, implied or otherwise, and is not responsible for the information you receive from the third-party linked sites, or any support related to technology.

If you want to manually do this, you can refer to the following steps:

Select the Column (Once one Column), click Subtotal in Data Tab:

After the above settings are completed, click OK, and you can see that a new column will appear at the front, which is the auxiliary column we need.

Then we select the auxiliary column area, pay attention to the area range, from the first row to the end of the data to be merged:

Then use the positioning condition, use the shortcut key "Ctrl+g" or the F5 key to quickly appear the positioning dialog box:

There is a Special.. option in the lower left corner of the targeting dialog box, click it and select Blanks. Click OK to return to the table, and you can see that all the null values in the positioning area in the first column are selected.

Click the Merge Cells function in the Home Tab to merge several selected blank cells at the same time.

Use the format brush function to brush the format of the auxiliary column to a column of the test number:

Select any cell in the table data, find Subtotal under the Data tab, and select Delete All in the lower left corner of the Subtotal dialog box:

At last, delete the auxiliary column.

Sincerely,

Tin | Microsoft Community Moderator

Answer 2

I managed to tweak my existing code.

But you are welcome to post your solutions.

Sub MergeSameCellversionthree() 

Dim Rng As Range, xCell As Range 

Dim xRows As Integer 

Set WorkRng = Application.Selection 

Application.ScreenUpdating = False 

Application.DisplayAlerts = False 

xRows = WorkRng.Rows.Count 

    For i = 1 To xRows - 1 

        For j = i + 1 To xRows 

            If WorkRng.Cells(i, 1).Value <> WorkRng.Cells(j, 1).Value Then 

                Exit For 

            End If 

        Next 

        WorkRng.Parent.Range(WorkRng.Cells(i, 1), WorkRng.Cells(j - 1, 1)).Merge 

        WorkRng.Parent.Range(WorkRng.Cells(i, 2), WorkRng.Cells(j - 1, 2)).Merge 

        WorkRng.Parent.Range(WorkRng.Cells(i, 3), WorkRng.Cells(j - 1, 3)).Merge 

        WorkRng.Parent.Range(WorkRng.Cells(i, 4), WorkRng.Cells(j - 1, 4)).Merge 

        i = j - 1 

    Next 

Application.DisplayAlerts = True 

Application.ScreenUpdating = True 

End Sub

Answer 3

Appreciate your efforts in offering the solution. The output you shared is different from what I have shown.

I need VBA solution to apply on a range within a template.

Edit: Managed to tweak my own code.

Answer 4

If you want to manually do this, you can refer to the following online tool

Answer 5

But you are welcome to post your solutions.

A Pivot table in Tabular format is very similar:

And we can e.g. add an empty line to add more clarity:

The benefit is you can still use your original data for analyze, after your code has run it looks nice, but the data is junk.

Andreas.