vba to merge Rows based on Values in Column A

aravindhan_31

Well-known Member
Joined
Apr 11, 2006
Messages
672
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
Hi,

I have data in columns A to U like. Column A data as below ( data starts from row 2)
Colum A
A
A
A
B
B
C
D
E
E
E
now need to merge few columns C, E, O & P based on values in A, in all these columns,
rows 2 to 4 should be merged ( All "A"s) , Rows 5 & 6 (All "B"s) should be merged & rows 7 & 8 should be merged since it ha only one row ( "C" & "D")
again All E's to be merged.

Can any one help me with the macro for this:)

thanks in advance
Arvind
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sub macro1()
Dim lngLastRow As String
Dim lastRow As Long
Dim lastcolumn As Long
Application.ScreenUpdating = False

lastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
lastcolumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count

ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range(Cells(2, 1), Cells(lastRow, 1)), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With ActiveSheet.Sort
.SetRange Range(Cells(1, 1), Cells(lastRow, lastcolumn))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

For i = lastRow To 2 Step -1

If Cells(i, 1).Value = Cells(i - 1, 1).Value Then
Cells(i - 1, 3).Value = Cells(i - 1, 3).Value & " , " & Cells(i, 3).Value
Cells(i - 1, 5).Value = Cells(i - 1, 5).Value & " , " & Cells(i, 5).Value
Cells(i - 1, 15).Value = Cells(i - 1, 15).Value & " , " & Cells(i, 15).Value
Cells(i - 1, 16).Value = Cells(i - 1, 16).Value & " , " & Cells(i, 16).Value
Rows(i).EntireRow.Delete
End If

Next
Application.ScreenUpdating = True

End Sub
 
Upvote 0
Hi,

Thanks much, but this is concatenating the data, I just want to merge cells into one cell.all the respective rows I will have same value. for ex in Col C I will see 100% for all the rows 2 to 4, so f I merge I will see only one 100% or if all cells are blank, I still want to merge cells.
 
Upvote 0
Sub macro1()
Dim lngLastRow As String
Dim lastRow As Long
Dim lastcolumn As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
lastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
lastcolumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count

ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range(Cells(2, 1), Cells(lastRow, 1)), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With ActiveSheet.Sort
.SetRange Range(Cells(1, 1), Cells(lastRow, lastcolumn))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

For i = lastRow To 2 Step -1

If Cells(i, 1).Value = Cells(i - 1, 1).Value Then
Range(Cells(i, 3), Cells(i - 1, 3)).Select
Selection.Merge
Range(Cells(i, 5), Cells(i - 1, 5)).Select
Selection.Merge
Range(Cells(i, 15), Cells(i - 1, 15)).Select
Selection.Merge
Range(Cells(i, 16), Cells(i - 1, 16)).Select
Selection.Merge

End If

Next
Application.ScreenUpdating = True

End Sub
 
Upvote 0
Sorry for the delay in response, I was away for quite some time. This one worked perfectly..
 
Upvote 0
you are welcome!

Hello @bhos123

this Macro is incredible! However, Can you help explain it to me a bit? I ran this on one of my spreadsheets and it worked perfectly with 1 exceptions:
1) I did not merge the data in my 2nd and 7th columns.

My scenario: I have 7 columns that I need to merge if the data is Column A is the same. I need all of the data in the columns so it would just be Concatenating the data together and not duplicating the same value in Column A.

Any Help is much appreciated!

Caleb
 
Upvote 0
In my code 3 stands for C, 5 stands for E, 15 stands for O and 16 stands for P as in 1-26 for alphabets A to Z, and again 27 for AA, 28 for AB ..and so on. depends on your columns you change the numbers, if required add new statements.
 
Upvote 0
In my code 3 stands for C, 5 stands for E, 15 stands for O and 16 stands for P as in 1-26 for alphabets A to Z, and again 27 for AA, 28 for AB ..and so on. depends on your columns you change the numbers, if required add new statements.

Hello @bhos123

I have the exact same problem and I used your codes (2nd one) to merge other columns based on column A. However, I have a header and basically the rows I want to merge start from row 3 and so on. Using your codes makes my header move to the last row and the merging only occurs on column B but not column A. Can you help please? I've been looking for codes to merge for a while now so your help is appreciated!
 
Upvote 0
Hi,

change the below line


For i = lastRow To 2 Step -1

to


For i = lastRow To 3 Step -1

this will merge from row 3 onwards.
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,238
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top