Merge cells in column A in function of the number of items written in column B

[Doflamingo]

Hi all,

I’m looking for the lines of code that would allow me to merge cells in column A where the number of cells merged in that column represent the number of items written in the column B.

Here is the code of the listbox 1 and listbox 2 that put items from those listboxes in the column B of an excel sheet

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

Here is the code of a previous thread that merge cells in column B where the number of cells merged in that column represent the number of items which have the same syntax written in the column A

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

Here is the thread: Merge cells by count vba

Does anyone have an idea about how to adapt those lines of code to a listbox from a userform ?

Many thanks in advance

 

[Doflamingo]

Can anyone say me why the lines of code in red does not work ?

Private Sub CommandButton5_Click()


With Sheets("Data")
   nextrow = .Range("B" & Rows.Count).End(xlUp).Row + 3
   .Range("A" & nextrow).Value = TextBox1.Value
[COLOR=#ff0000]   mergerow = .Range("B" & Rows.Count).End(xlUp).Row + 1[/COLOR]
[COLOR=#ff0000]   .Range("A" & mergerow).Value.Merge[/COLOR]
   
   
   For b = 0 To ListBox1.ListCount - 1
      .Range("B" & nextrow) = ListBox1.List(b)
      nextrow = nextrow + 1
   Next b
   
   For c = 0 To ListBox2.ListCount - 1
   .Range("B" & nextrow) = ListBox2.List(c)
      nextrow = nextrow + 1
   Next c
   
End With

many thanks in advance

 

[Doflamingo]

I've changed the code a little bit but still does not work...

With Sheets("Data")
   nextrow = .Range("B" & Rows.Count).End(xlUp).Row + 3
   .Range("A" & nextrow).Value = TextBox1.Value
[COLOR=#ff0000]   mergerow = .Range("B" & Rows.Count).End(xlUp).Row + 1[/COLOR]
[COLOR=#ff0000]   .Range("A" & mergerow).Select[/COLOR]
[COLOR=#ff0000]   Selection.Merge[/COLOR]




     
   For b = 0 To ListBox1.ListCount - 1
      .Range("B" & nextrow) = ListBox1.List(b)
      nextrow = nextrow + 1
   Next b
   
   For c = 0 To ListBox2.ListCount - 1
   .Range("B" & nextrow) = ListBox2.List(c)
      nextrow = nextrow + 1
   Next c
   
End With

Really ? Nobody has an idea ?

 

[DanteAmor]

Try this

Private Sub CommandButton5_Click()
    With Sheets("Data")
        lr1 = .Range("B" & Rows.Count).End(xlUp)(2).Row
        .Range("B" & Rows.Count).End(xlUp)(2).Resize(ListBox1.ListCount).Value = ListBox1.List
        .Range("B" & Rows.Count).End(xlUp)(2).Resize(ListBox2.ListCount).Value = ListBox2.List
        lr2 = .Range("B" & Rows.Count).End(xlUp).Row
        .Range("A" & lr1 & ":A" & lr2).Merge
    End With
End Sub

If it is not what you need, you could put a couple of images before putting the data on the sheet and after putting the data show what you want.

 

[Doflamingo]

Dear @DanteAmor

Many thanks for your answer, the code you gave me is almost what I would like.

Here is what I have with that code

With Sheets("Data")
   nextrow = .Range("B" & Rows.Count).End(xlUp).Row + 3
   .Range("A" & nextrow).Value = TextBox1.Value
   mergerow = .Range("B" & Rows.Count).End(xlUp).Row + 1
   .Range("A" & mergerow).Select
   Selection.Merge
     
   For b = 0 To ListBox1.ListCount - 1
      .Range("B" & nextrow) = ListBox1.List(b)
      nextrow = nextrow + 1
   Next b
   
   For c = 0 To ListBox2.ListCount - 1
   .Range("B" & nextrow) = ListBox2.List(c)
      nextrow = nextrow + 1
   Next c
   
End With

Here is the link

https://www.dropbox.com/s/ahk92few8rzzlnc/1.png?dl=0

and here is what I would like to obtain

https://www.dropbox.com/s/i1sax8g2p7dmodd/2.png?dl=0

The code you gave me does not include the textbox value and actually the values of the listbox1 and the listbox2 are displayed in the column B below each other and at each time I activate the command button of the above code, I have 2 separate rows for each statement.

 

[Doflamingo]

Hello @DanteAmor

I have included the textbox value in the code you gave me

With Sheets("Data")
        lr1 = .Range("B" & Rows.Count).End(xlUp)(2).Row
        .Range("B" & Rows.Count).End(xlUp)(2).Resize(ListBox1.ListCount).Value = ListBox1.List
        .Range("B" & Rows.Count).End(xlUp)(2).Resize(ListBox2.ListCount).Value = ListBox2.List
        lr2 = .Range("B" & Rows.Count).End(xlUp).Row
        .Range("A" & lr1 & ":A" & lr2).Merge
        .Range("A" & lr1 & ":A" & lr2).Value = TextBox1.Value
End With
ListBox1.Clear
ListBox2.Clear
TextBox1 = ""

Do you have any idea how to add 2 empty row at each time I activate the commandbutton ?

 

[DanteAmor]

Dear @DanteAmor

Many thanks for your answer, the code you gave me is almost what I would like.

The code you gave me does not include the textbox value and actually the values of the listbox1 and the listbox2 are displayed in the column B below each other and at each time I activate the command button of the above code, I have 2 separate rows for each statement.

Of course, my code does not include the textbox, because in your original request it was not mentioned.

 

[DanteAmor]

Hello @DanteAmor

I have included the textbox value in the code you gave me


Do you have any idea how to add 2 empty row at each time I activate the commandbutton ?

Try this:

Private Sub CommandButton5_Click()
    With Sheets("Data")
        lr1 = .Range("B" & Rows.Count).End(xlUp)(4).Row
        .Range("B" & Rows.Count).End(xlUp)(4).Resize(ListBox1.ListCount).Value = ListBox1.List
        lr2 = .Range("B" & Rows.Count).End(xlUp).Row
        .Range("A" & lr1 & ":A" & lr2).Merge
        .Range("A" & lr1 & ":A" & lr2).Value = TextBox1.Value
        
        lr1 = .Range("B" & Rows.Count).End(xlUp)(4).Row
        .Range("B" & Rows.Count).End(xlUp)(4).Resize(ListBox2.ListCount).Value = ListBox2.List
        lr2 = .Range("B" & Rows.Count).End(xlUp).Row
        .Range("A" & lr1 & ":A" & lr2).Merge
        .Range("A" & lr1 & ":A" & lr2).Value = TextBox1.Value
    End With
End Sub

 

[Doflamingo]

Hello @DanteAmor

Many thanks for your answer

That's almost what I'm looking for but maybe my explanations were not so good because in the link what I'm looking for

https://www.dropbox.com/s/i1sax8g2p7dmodd/2.png?dl=0

the cell b4 to b11 represent the items of the listbox1 AND the listbox 2, for a 1st statement, where in the merged cell in the column A represent the value of the textbox

For a 2nd statement, B14 to B16 represent others items of the listbox1 AND the listbox 2 and in the merged cell in the column A represent an other value of the textbox

 

[Doflamingo]

Dear @DanteAmor

So many thanks for your help

Here is what I was looking for, I've changed in red the item that had to be changed to get what I wanted

With Sheets("Data")
        lr1 = .Range("B" & Rows.Count).End(xlUp)(4).Row
        .Range("B" & Rows.Count).End(xlUp)([COLOR=#ff0000]4[/COLOR]).Resize(ListBox1.ListCount).Value = ListBox1.List
        .Range("B" & Rows.Count).End(xlUp)(2).Resize(ListBox2.ListCount).Value = ListBox2.List
        lr2 = .Range("B" & Rows.Count).End(xlUp).Row
        .Range("A" & lr1 & ":A" & lr2).Merge
        .Range("A" & lr1 & ":A" & lr2).Value = TextBox1.Value
End With
ListBox1.Clear
ListBox2.Clear
TextBox1 = ""

So now I'm looking for how to get border for each filled cell