Help with insert row and merge cells code

[Fedor]

Hello mrexcel Community

I have a problem with my VBA Code in Excel, I dont speak VBA or even english

The code I have tried to create is not doing what I want it to do. When I click on the Command Button than it does not create a new Row.
The result of my tryings is this one:

Private Sub CommandButton4_Click()
    Dim finden, cell As Range
    Dim Wert As String
    Dim MyRange As Object
    Set finden = Range("B1:B500")
    
    For Each cell In finden
        If cell.Text = "Names:" Then
            cell.Select
            With ActiveCell
                .Offset(1, 0).Activate
            End With
        Else
        End If
    Next
    ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    Range(Cells(ActiveCell.Row, "B"), Cells(ActiveCell.Row, "F")).MergeCells = True
End Sub

I have 3 lists in my excel sheet and my idea was, when I click on an button, it will add a new row underneath and merge the cells from B-F.

I apologize for my bad english and hope someone can help me.

 

[Fishboy]

Hello mrexcel Community

I have a problem with my VBA Code in Excel, I dont speak VBA or even english

The code I have tried to create is not doing what I want it to do. When I click on the Command Button than it does not create a new Row.
The result of my tryings is this one:

Private Sub CommandButton4_Click()
    Dim finden, cell As Range
    Dim Wert As String
    Dim MyRange As Object
    Set finden = Range("B1:B500")
    
    For Each cell In finden
        If cell.Text = "Names:" Then
            cell.Select
            With ActiveCell
                .Offset(1, 0).Activate
            End With
        Else
        End If
    Next
    ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    Range(Cells(ActiveCell.Row, "B"), Cells(ActiveCell.Row, "F")).MergeCells = True
End Sub

I have 3 lists in my excel sheet and my idea was, when I click on an button, it will add a new row underneath and merge the cells from B-F.

I apologize for my bad english and hope someone can help me.

Hi Fedor, welcome to the boards.

If I am understanding your code correctly, try out the following tweaked version in a COPY of your workbook:

Private Sub CommandButton4_Click()
    Dim finden, cell As Range
    Dim Wert As String
    Dim MyRange As Object
    Set finden = Range("B1:B500")
    
    For Each cell In finden
        If cell.Text = "Names:" Then
            cell.Offset(1, 0).Activate
            With ActiveCell
                .EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
            End With
                    Range(Cells(ActiveCell.Row, "B"), Cells(ActiveCell.Row, "F")).MergeCells = True
                
        End If
    Next
End Sub

 

[Fedor]

yay this works! thank you very much!
but there is one issue, when you click on the Command button and a new row was inserted than you need to deselect it to make the button work again.

 

[Fishboy]

yay this works! thank you very much!
but there is one issue, when you click on the Command button and a new row was inserted than you need to deselect it to make the button work again.

Deselect the row or the button?

 

[Fedor]

Deselect the row or the button?

Ah okay i see, when you click to fast than it selects the button and i need to deselect it... Thank you very much for your help Fishboy, you are awesome!

 

[Fishboy]

Ah okay i see, when you click to fast than it selects the button and i need to deselect it... Thank you very much for your help Fishboy, you are awesome!

Happy to help mate