VBA Inserting a row

[FelixExcel]

Hey all. Right now I have a command button, which inserts a row at a specific place. In the first cell of the inserted row a text is displayed and at the front of the text a number, which is set by how often the commandbutton has been pressed before. So, the first inserted row will say 1 "Text" in the first cell of that row and the second inserted row will say 2 "Text" in the first cell of that row and so on.

Private Sub CommandButton1_Click()

Sheets("Tabelle1").Range("A17").Select
ActiveCell.EntireRow.Insert Shift:=x1Down

Sheets("Tabelle1").Range("A17").Select
ActiveCell.Value = counter & ". Nachtrag"

The problem I have with this is that because the Rows always get inserted at a fixed place (A17) and shift the other rows down the newest added row is always on top, like this:

3. Text
2. Text
1. Text

Instead I would like them to be like this:

1. Text
2. Text
3. Text

Therefore I want to tell vba that depending on how often the commandbutton has been pressed before the row gets inserted at A17+ Counter. So for example if 2 rows have been added before, the new row will not be inserted at A17 but at A17+2 so A19.

I would appreciate any help.

 

[mumps]

Try:

Private Sub CommandButton1_Click()
    Sheets("Tabelle1").Cells(Sheets("Tabelle1").Rows.Count, "A").End(xlUp).Offset(1) = counter & ". Nachtrag"
End Sub

 

[FelixExcel]

Try:

Private Sub CommandButton1_Click()
    Sheets("Tabelle1").Cells(Sheets("Tabelle1").Rows.Count, "A").End(xlUp).Offset(1) = counter & ". Nachtrag"
End Sub

Thank you for your response, could you explain the code a bit?

 

[mumps]

The code simply finds the last cell with data in column A and places the text in the cell below it.

 

[FelixExcel]

The code simply finds the last cell with data in column A and places the text in the cell below it.

The problem is there are cells with data in column A after the inserted rows. I managed to insert the row above a row with a certain word in it. For example if in cell A23 its says "Hello" so then the row is inserted over the row where it says "hello"? I did this with Cells.Find("hello").EntireRow.Insert Shift:=x1Down

The problem I have with this is that I dont know how to format the cells in the newly added row. For example do i need to add some boarders, text and formulars to certain cells in the new row. Down below is my current code where you can see all the formatting.


Private Sub CommandButton1_Click()

unprotect1

counter = ThisWorkbook.Sheets("Tabelle2").Range("J2")

Sheets("Tabelle1").Range("A17").Select
ActiveCell.EntireRow.Insert Shift:=x1Down

Sheets("Tabelle1").Range("A17").Select
ActiveCell.Value = counter & ". Nachtrag"

Sheets("Tabelle1").Range("H17").Select
ActiveCell.Formula = "=(g17*0.19)"

Sheets("Tabelle1").Range("I17").Select
ActiveCell.Formula = "=(g17*1.19)"

Sheets("Tabelle1").Range("G17").Select
ActiveCell.Borders(xlEdgeLeft).Weight = xlThin

Sheets("Tabelle1").Range("G17").Select
ActiveCell.Borders(xlEdgeRight).Weight = xlThin

Sheets("Tabelle1").Range("G17").Select
ActiveCell.Borders(xlEdgeTop).Weight = xlThin

Sheets("Tabelle1").Range("G17").Select
ActiveCell.Borders(xlEdgeBottom).Weight = xlThin

Sheets("Tabelle1").Range("G17").Select
ActiveCell.Borders.Color = RGB(193, 193, 193)

Sheets("Tabelle1").Range("G17").Select
ActiveCell.Interior.Color = RGB(247, 247, 247)

Sheets("Tabelle1").Range("C17").Select
ActiveCell.Borders(xlEdgeLeft).Weight = xlThin

Sheets("Tabelle1").Range("C17").Select
ActiveCell.Borders(xlEdgeRight).Weight = xlThin

Sheets("Tabelle1").Range("C17").Select
ActiveCell.Borders(xlEdgeTop).Weight = xlThin

Sheets("Tabelle1").Range("C17").Select
ActiveCell.Borders(xlEdgeBottom).Weight = xlThin

Sheets("Tabelle1").Range("C17").Select
ActiveCell.Borders.Color = RGB(193, 193, 193)

Sheets("Tabelle1").Range("C17").Select
ActiveCell.Interior.Color = RGB(247, 247, 247)

protect1

End Sub

 

[mumps]

It is hard to work with a picture. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[FelixExcel]

It is hard to work with a picture. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

Filebin | 96vof7i29i270knc

Convenient file sharing. Think of it as Pastebin for files. Registration is not required. Large files are supported.

filebin.net

In Row 17 there are 2 buttons, one to add a row (Nachtrag hinzufügen) and one to delete a row. If you press the button to add a row you will notice that If you add several rows, the newest row will be placed over the row that was added before. I want it to be the exact opposite way around, so the latest row is placed under the older rows. The rows also have to have certain formatting, which you can see in the code.

 

[mumps]

What is the purpose of all the blank hidden rows from row 18 to row 217?

 

[FelixExcel]

What is the purpose of all the blank hidden rows from row 18 to row 217?

Further down the sheet there are 2 more buttons that pretty much do the same things as the button from the top. If a row is added from the bottom from the top the botton at the end of the sheet will insert the rows at the wrong place as the newly added rows at the top made it that the sheet has more rows. Therefore I added a lot of rows and gave them the height 0, so there are not visible. When the button at the top is pressed and a new row is created one of the invisible rows is deleted, so the number of rows stays the same in the sheet.

 

[mumps]

Click here to download your file. Please note that I have deleted all the blank rows and modified your macros as below. Please let me know how it works out.

Dim counter As Long
Dim counter1 As Long

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim fnd As Range
    With ActiveSheet
        .unprotect "BMP"
        counter = Sheets("Tabelle2").Range("J2")
        Set fnd = .Range("A:A").Find("Nachbeauftragung", LookIn:=xlValues, lookat:=xlPart)
        .Range("A" & fnd.Row).EntireRow.Insert Shift:=x1Down
        .Range("A" & fnd.Row - 1) = counter & ". Nachtrag"
        .Range("C16:I16").Copy
        .Range("C" & fnd.Row - 1).PasteSpecial xlPasteFormats
        .Range("C" & fnd.Row - 1).PasteSpecial xlPasteFormulas
        .Range("C" & fnd.Row - 1).Resize(, 5).ClearContents
        .protect "BMP"
    End With
    Application.ScreenUpdating = True
    End Sub
    
    Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False
    Dim fnd As Range
    With ActiveSheet
        .unprotect "BMP"
        counter1 = Sheets("Tabelle2").Range("J3")
        Set fnd = .Range("A:A").Find("Objektüberwachung", LookIn:=xlValues, lookat:=xlPart)
        .Range("A" & fnd.Row).EntireRow.Insert Shift:=x1Down
        .Range("A" & fnd.Row - 1) = counter1 & ". Abschlagsrechnung"
        .Range("H16").Copy
        .Range("C" & fnd.Row - 1).RowHeight = 14
        .Range("H" & fnd.Row - 1).Resize(, 2).PasteSpecial xlPasteFormats
        .Range("H" & fnd.Row - 1).Resize(, 2).PasteSpecial xlPasteFormulas
        .Range("C16").Copy
        .Range("G" & fnd.Row - 1).PasteSpecial xlPasteFormats
        .protect "BMP"
    End With
    Application.ScreenUpdating = True
End Sub

Private Sub CommandButton3_Click()
    With Sheets("Tabelle1")
        .unprotect "BMP"
        .Cells.Find(". Nachtrag").EntireRow.Delete
        .protect "BMP"
    End With
End Sub

Private Sub CommandButton4_Click()
    With Sheets("Tabelle1")
        .unprotect "BMP"
        .Cells.Find(". Abschlagsrechnung").EntireRow.Delete
        .protect "BMP"
    End With
End Sub