Merge cells by count vba

[donniedorian]

Hello,

I need a macro to merge as many cell in B as cells the same in a column A

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]aaaaa
[/TD]
[TD]merg 4
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]aaaaa
[/TD]
[TD]merg 4[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]aaaaa
[/TD]
[TD]merg 4
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]aaaaa
[/TD]
[TD]merg 4[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD]bb
[/TD]
[TD]merge 2
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]bb
[/TD]
[TD]merge 2
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[KOKOSEK]

I don't see which cells are merged in col A in your post.
But try like this:

Sub MergeBAsInColA()
Dim cellsA As Range
For Each cellsA In Sheets("Sheet1").Range("A1:A50")
    If cellsA.MergeCells Then
        Range(Replace(cellsA.MergeArea.Address, "A", "B")).Merge
    End If
Next cellsA
End Sub

 

[donniedorian]

Hi Kokosek,
I need as many cells to be merged in column B as cells with the same value in column A
column A has 4 rows of the same cells aaaa so I need 4 rows to be merged adjacent in column B
for the bbb value I need two cells in column B to me merged

 

[KOKOSEK]

That's definitely more clear for me.

Sub MergeBbasedonValinA()
Dim cellsA As Range
Dim i As Long
i = 1
For Each cellsA In Sheets("Sheet1").Range("A2:A50") 'expand range to your needs
    If cellsA.Value <> cellsA.Offset(1, 0).Value Then
        Range("B" & i & ":B" & cellsA.Row).Merge
        i = cellsA.Row + 1
    End If
Next cellsA


End Sub

 

[donniedorian]

Worked,
Thank you very much for the macro solution Kokosek

 

[Doflamingo]

Hi all,

Does anyone have an idea how to adapt this code to the number of items of a listbox ?

Here is the code of 2 istboxes from a userform where all the items displayed in listbox 1 and listbox 2 are written in the column B of an Excel sheet

Sheet9.Activate


For b = 0 To ListBox1.ListCount - 1
With Sheets("Data")
     nextRow = .Range("B" & Rows.Count).End(xlUp).Row + 1
     .Range("B" & nextRow) = ListBox1.List(b)
End With
Next


For c = 0 To ListBox2.ListCount - 1
With Sheets("Data")
     nextRow = .Range("B" & Rows.Count).End(xlUp).Row + 1
     .Range("B" & nextRow) = ListBox2.List(c)
End With
Next

But how to merge the cells in the column A where the number of cells of the column A represent the number of items of the listbox 1 + the listbox 2 ?

Any ideas ?