vba to merge Rows based on Values in Column A

[aravindhan_31]

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

 

[mimosa91]

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.

Hello @bhos123,

Thank you for your reply! I figured out how to merge from row 3 onwards and not including the header as well by taking off the .Header=xlYes on the code below:

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

Now, my other problem is, once I got this code working (merging on both column A & B), whenever I add more data to the worksheet, the data will always only get transferred to row 12. Only if I get rid of all the existing data and unmerge the whole worksheet will the code for transferring the data work well. Can you help once again please?

 

[bhos123]

where do you have your complete data... and where is your headers?? this macro was prepared for 1 time run only. are you adding the data after doing merge operations? and you want to do the merging of the new data ?? if yes, will new data can have the same values in column A as that of old data? I am from India. may I know which country you belong?

 

[mimosa91]

where do you have your complete data... and where is your headers?? this macro was prepared for 1 time run only. are you adding the data after doing merge operations? and you want to do the merging of the new data ?? if yes, will new data can have the same values in column A as that of old data? I am from India. may I know which country you belong?

I have my userform on tab 1 of the spreadsheet, transferring my data to tab 2. My header is on row 2 and data gets transferred to row 3 and onwards. Yes, I would like to still add data after doing the merge operations and the new data will also get merged once transferred, is it possible? The new data should be different values from the old data on column A. I am from the US.

 

[bhos123]

yes, why do you want to merge, we can simply delete the duplicates in data. correct?

 

[mimosa91]

yes, why do you want to merge, we can simply delete the duplicates in data. correct?

Hello bhos123,

The reason why I would like to merge the data is simply to make it cleaner and neat. It looks something like the table below. Item #510 uses two case types, and instead of listing 510 and French Rolls twice, I would like to merge it so that it does not look too pack. Is it possible to do so? Again, like I have mentioned before, I would like the code to keep updating whenever new data is added to the worksheet. Anyway, thanks for your responses. I appreciate it!

[TABLE="width: 500"]
<tbody>[TR]
[TD]Item #[/TD]
[TD]Product[/TD]
[TD]Case Type[/TD]
[/TR]
[TR]
[TD]510[/TD]
[TD]French Rolls[/TD]
[TD]M-Box[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Panini Box[/TD]
[/TR]
[TR]
[TD]528[/TD]
[TD]White Bun[/TD]
[TD]F&E Box[/TD]
[/TR]
[TR]
[TD]514[/TD]
[TD]Hot Dog[/TD]
[TD]Hotdog Box[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]Artisan[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 280"]
<tbody>[TR]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[Fluff]

Best advice, avoid merged cells like the plague!!
Whilst you may think that it makes things look "neater" or "cleaner", they will come back to haunt you.

 

[mimosa91]

Best advice, avoid merged cells like the plague!!
Whilst you may think that it makes things look "neater" or "cleaner", they will come back to haunt you.

Hello Fluff,

So, are there any other ways to merge rows instead of using the merge button? I looked for some other ways but that requires me to install add ins. If there is a formula that I can use, that'd be great

 

[Fluff]

I would leave it "as is", that way you still have the data so that it can be used in formulae/VBA.
If you remove it now, you may regret it later.

 

[bhos123]

I will prepare a macro and send you in next 2-3 days.

 

[bhos123]

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