vba to merge Rows based on Values in Column A

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
 
Sort by date Sort by votes
your data should be in "Sheet1"

and change the below statements as per your choice

If Cells(i, 1).Value = Cells(i - 1, 1).Value Then
Range(Cells(i, 1), Cells(i - 1, 1)).Select
Selection.Merge
Range(Cells(i, 2), Cells(i - 1, 2)).Select
Selection.Merge
Range(Cells(i, 3), Cells(i - 1, 3)).Select
Selection.Merge
Range(Cells(i, 4), Cells(i - 1, 4)).Select
Selection.Merge

1 stands for A, 2 stands B , and 3 for C and 4 for D. I am doing merging in only these 4 columns. Change these lines as per your requirement, add more if you want to merge more columns.
 
Upvote 0

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
bhos123 said:
Code: 
Sub macro1()

Dim x1 As Long
x1 = 2
For i = 1 To Worksheets.Count
    If Worksheets(i).Name = "Backupdata" Then
        exists = True
        Sheets("Backupdata").Visible = True
    End If
Next i

If Not exists Then
    Worksheets.Add.Name = "Backupdata"
    x1 = 1
    Sheets("Sheet1").Select
    Cells.Select
    Selection.Copy
    Sheets("Backupdata").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If

Dim lastRow, lastRow_b As Long
Dim lastcolumn, lastcolumn_b As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Sheets("Sheet1").Select
lastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
lastcolumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count

Sheets("Backupdata").Select
lastRow_b = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
lastcolumn_b = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count

If x1 = 1 Then

Sheets("Sheet1").Select
    Rows("3:3").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(Cells(3, 1), Cells(lastRow, 1)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range(Cells(2, 1), Cells(lastRow, lastcolumn))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    

For i = lastRow To 4 Step -1

If Cells(i, 1).Value = Cells(i - 1, 1).Value Then
Range(Cells(i, 1), Cells(i - 1, 1)).Select
Selection.Merge
Range(Cells(i, 2), Cells(i - 1, 2)).Select
Selection.Merge
Range(Cells(i, 3), Cells(i - 1, 3)).Select
Selection.Merge
Range(Cells(i, 4), Cells(i - 1, 4)).Select
Selection.Merge

End If

Next
End If

If x1 = 2 Then
If lastRow_b = lastRow Then
Sheets("Backupdata").Visible = False
Exit Sub
End If
Sheets("Backupdata").Visible = True
Sheets("Sheet1").Select
    Range(Cells(lastRow_b + 1, 1), Cells(lastRow, lastcolumn)).Select
    Selection.Copy
    Sheets("Backupdata").Select
    Range("A" & lastRow_b + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Sheets("Sheet1").Select
    Rows(lastRow_b + 1).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(Cells(lastRow_b + 1, 1), Cells(lastRow, 1)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range(Cells(lastRow_b, 1), Cells(lastRow, lastcolumn))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    

For i = lastRow To lastRow_b + 2 Step -1

If Cells(i, 1).Value = Cells(i - 1, 1).Value Then
Range(Cells(i, 1), Cells(i - 1, 1)).Select
Selection.Merge
Range(Cells(i, 2), Cells(i - 1, 2)).Select
Selection.Merge
Range(Cells(i, 3), Cells(i - 1, 3)).Select
Selection.Merge
Range(Cells(i, 4), Cells(i - 1, 4)).Select
Selection.Merge
   

End If
Next
End If

Sheets("Backupdata").Visible = False
Application.ScreenUpdating = True


End Sub
Click to expand...

Hello @bhos123,

Thank you for your codes! I will let you know the result once I get the chance to try it out. Once again, thank you for the help! Really appreciate it!
 
Upvote 0
bhos123 said:
Code: 
Sub macro1()

Dim x1 As Long
x1 = 2
For i = 1 To Worksheets.Count
    If Worksheets(i).Name = "Backupdata" Then
        exists = True
        Sheets("Backupdata").Visible = True
    End If
Next i

If Not exists Then
    Worksheets.Add.Name = "Backupdata"
    x1 = 1
    Sheets("Sheet1").Select
    Cells.Select
    Selection.Copy
    Sheets("Backupdata").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If

Dim lastRow, lastRow_b As Long
Dim lastcolumn, lastcolumn_b As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Sheets("Sheet1").Select
lastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
lastcolumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count

Sheets("Backupdata").Select
lastRow_b = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
lastcolumn_b = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count

If x1 = 1 Then

Sheets("Sheet1").Select
    Rows("3:3").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(Cells(3, 1), Cells(lastRow, 1)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range(Cells(2, 1), Cells(lastRow, lastcolumn))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    

For i = lastRow To 4 Step -1

If Cells(i, 1).Value = Cells(i - 1, 1).Value Then
Range(Cells(i, 1), Cells(i - 1, 1)).Select
Selection.Merge
Range(Cells(i, 2), Cells(i - 1, 2)).Select
Selection.Merge
Range(Cells(i, 3), Cells(i - 1, 3)).Select
Selection.Merge
Range(Cells(i, 4), Cells(i - 1, 4)).Select
Selection.Merge

End If

Next
End If

If x1 = 2 Then
If lastRow_b = lastRow Then
Sheets("Backupdata").Visible = False
Exit Sub
End If
Sheets("Backupdata").Visible = True
Sheets("Sheet1").Select
    Range(Cells(lastRow_b + 1, 1), Cells(lastRow, lastcolumn)).Select
    Selection.Copy
    Sheets("Backupdata").Select
    Range("A" & lastRow_b + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Sheets("Sheet1").Select
    Rows(lastRow_b + 1).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(Cells(lastRow_b + 1, 1), Cells(lastRow, 1)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range(Cells(lastRow_b, 1), Cells(lastRow, lastcolumn))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    

For i = lastRow To lastRow_b + 2 Step -1

If Cells(i, 1).Value = Cells(i - 1, 1).Value Then
Range(Cells(i, 1), Cells(i - 1, 1)).Select
Selection.Merge
Range(Cells(i, 2), Cells(i - 1, 2)).Select
Selection.Merge
Range(Cells(i, 3), Cells(i - 1, 3)).Select
Selection.Merge
Range(Cells(i, 4), Cells(i - 1, 4)).Select
Selection.Merge
   

End If
Next
End If

Sheets("Backupdata").Visible = False
Application.ScreenUpdating = True


End Sub
Click to expand...

Hello @bhos123,

I have tried your code but it gives me runtime error 1004 - object defined error or application error. Also, can you explain a little about the code? What is the back up data for? I am new to this so it is quite hard for me to understand what is going on. :confused:
 
Upvote 0
which line you are getting error? do you have the data in 'Sheet1' tab, even then if you are getting the error. mail me the sample data to mahipaldotisiattherategmaildotcom

replace dot attherate with corresponding symbols.
 
Last edited:
Upvote 0
bhos123 said:
which line you are getting error? do you have the data in 'Sheet1' tab, even then if you are getting the error. mail me the sample data to mahipaldotisiattherategmaildotcom

replace dot attherate with corresponding symbols.
Click to expand...

The worksheet that I need to do the merging is called Sheet3 (I rename the tab to be Line1) so I replaced all Sheet1 to Sheet3 on the codes. I put the codes on Sheet3. I saved and run the userform but it did nothing. I will send you my spreadsheet today.
 
Upvote 0
can you clearly tell me step-by-step.

1) where is your first data present
2) where do u want to see that results
3) where will you add more data
4) where do you u want see the updated results.

you never told me that you want to the merging in separate spreadsheet other than your data sheet, In my code the merging will happen on same spreadsheet. Send me the details step-by-step(I have received your excel file, may be you can use the same excel file and explain me step-by-step what you want.)
 
Upvote 0
bhos123 said:
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.
Click to expand...
Hello, i know its an old question. but code works like new :D i successfully adopted your code if u don t mind ;). I have one question, is it possible to revers this action. I mean to unmerge cells, merged before, like some undo macro for this macro?
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question
Merge Excel Multiple Sheets from a single work book to one sheet.
Replies
4
Views
133
rtr1811
R
V
  • Solved
simplest way in Excel to combine (merge)
Replies
4
Views
112
Fluff
Fluff
C
  • Solved
Merge based on Merged area of adjacent columns
Replies
2
Views
619
CodeNewb
C
J
  • Question
Combining VBA code together...need help!
Replies
3
Views
176
Fluff
Fluff
J
  • Solved
Combine rows based on previous column duplicate data
Replies
2
Views
210
jessiehayden
J

Forum statistics

Threads
1,215,108
Messages
6,123,129
Members
449,097
Latest member
mlckr

Share this page

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