Userform - "Add row below" button in VBA

[pilot09]

Hello everyone!

I create Userform with this tutorial: Fully Automated Data Entry Userform - TheDataLabs

Here is main code:

Option Explicit

Sub Reset()

    Dim iRow As Long
    
    iRow = [Counta(Database!A:A)] ' idetifying the last row
    
    With frmForm
        
        .txtNR.Value = ""
        
        .cmbDepartment4.Clear
        
        .cmbDepartment4.AddItem "/1/Zas./"
        .cmbDepartment4.AddItem "/2/Tech./"
        .cmbDepartment4.AddItem "/3/Z. gn./"
        .cmbDepartment4.AddItem "/4/San./"
        .cmbDepartment4.AddItem "/5/Gn./"
        .cmbDepartment4.AddItem "/6/Og./"
        .cmbDepartment4.AddItem "/7/Ośw./"
                    
        .txtNZ.Value = ""
        
        .txtRowNumber.Value = ""
        
        .txtPi.Value = ""

        .cmbDepartment1.Clear
        
        .cmbDepartment1.AddItem "0,95"
        .cmbDepartment1.AddItem "0,9"
        .cmbDepartment1.AddItem "0,85"
        .cmbDepartment1.AddItem "0,8"
        .cmbDepartment1.AddItem "0,75"
        .cmbDepartment1.AddItem "0,7"
        
        
         .cmbDepartment2.Clear
        
        .cmbDepartment2.AddItem "400"
        .cmbDepartment2.AddItem "230"
        .cmbDepartment2.AddItem "24"
        .cmbDepartment2.AddItem "12"
                
                
        .lstDatabase.ColumnCount = 9
        .lstDatabase.ColumnHeads = True
        
        
        .lstDatabase.ColumnWidths = "30,30,50,110,50,30,50,40,40"
        
        If iRow > 4 Then
        
            .lstDatabase.RowSource = "Database!A5:I" & iRow
        Else
        
            .lstDatabase.RowSource = "Database!A5:I5"
            
        End If
        
        
    
    End With



End Sub


Sub Submit()

    Dim sh As Worksheet
    Dim iRow As Long
    
    Set sh = ThisWorkbook.Sheets("Database")
    
    If frmForm.txtRowNumber.Value = "" Then
    
        iRow = [Counta(Database!A:A)] + 1
    Else
    
        iRow = frmForm.txtRowNumber.Value
        
    End If
    
    With sh
    
        .Cells(iRow, 1) = iRow - 1
        
        .Cells(iRow, 2) = frmForm.txtNR.Value
        
        .Cells(iRow, 3) = frmForm.cmbDepartment4.Value
        
        .Cells(iRow, 4) = frmForm.txtNZ.Value
              
        .Cells(iRow, 5) = frmForm.txtPi.Value
                      
        .Cells(iRow, 8) = frmForm.cmbDepartment1.Value
        
        .Cells(iRow, 9) = frmForm.cmbDepartment2.Value
        
        
    
    End With


End Sub


Sub Show_Form()
    
    frmForm.Show

End Sub


Function Selected_List() As Long

    Dim i As Long
    
    Selected_List = 0
    
    For i = 0 To frmForm.lstDatabase.ListCount - 1
        
        If frmForm.lstDatabase.Selected(i) = True Then
        
            Selected_List = i + 1
            Exit For
        End If
        
    Next i


End Function

And button codes:

Option Explicit

Private Sub cmdDelete_Click()

If Selected_List = 0 Then
    
        MsgBox "No row is selected.", vbOKOnly + vbInformation, "Delete"
        Exit Sub
    End If
    
    Dim i As VbMsgBoxResult
    
    i = MsgBox("Do you want to delete the selected record?", vbYesNo + vbQuestion, "Confirmation")
    
    If i = vbNo Then Exit Sub
    
    ThisWorkbook.Sheets("Database").Rows(Selected_List + 4).Delete
    
    Call Reset
    
    MsgBox "Selected record has been deleted.", vbOKOnly + vbInformation, "Deleted"


End Sub

Private Sub cmdEdit_Click()

 If Selected_List = 0 Then
    
        MsgBox "No row is selected.", vbOKOnly + vbInformation, "Edit"
        
        Exit Sub
    
    End If
    
    'Code to update the value to respective controls
    
    Me.txtRowNumber.Value = Selected_List + 4

    Me.cmbDepartment4.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 2)
    
    Me.txtNR.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 1)
    
    Me.txtNZ.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 3)
    
    Me.txtPi.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 4)
    
    Me.cmbDepartment1.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 7)
     
    Me.cmbDepartment2.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 8)
    
          
    MsgBox "Please make the required changes and click on 'Save' button to update.", vbOKOnly + vbInformation, "Edit"


End Sub

Private Sub cmdReset_Click()
    Dim msgValue As VbMsgBoxResult
    
    msgValue = MsgBox("Do you want to reset the form?", vbYesNo + vbInformation, "Confirmation")
    
    If msgValue = vbNo Then Exit Sub
    
    Call Reset
End Sub

Private Sub cmdSave_Click()
    
    Dim msgValue As VbMsgBoxResult
    
    msgValue = MsgBox("Do you want to save the data?", vbYesNo + vbInformation, "Confirmation")
    
    If msgValue = vbNo Then Exit Sub
    
    Call Submit
    Call Reset
    
    
End Sub

Private Sub cmdWstaw_Click()

If Selected_List = 0 Then
    
        MsgBox "No row is selected.", vbOKOnly + vbInformation, "Wstaw"
        
        Exit Sub
    
    End If





End Sub

Private Sub UserForm_Initialize()

    Call Reset

End Sub

I need create "Wstaw" button that insert new row below selected row. New row should have formulas from base row, only formulas, i dont want to copy any numbers or text form cells, i need only formulas. Please, can anyone help?

 

[sijpie]

Please look at the comments starting with <<<<. They need verifying

Private Sub cmdWstaw_Click()
    Dim vIn As Variant
    Dim lC As Long, lLst As Long
    Dim rHead As Range

    If Selected_List = 0 Then
    
        MsgBox "No row is selected.", vbOKOnly + vbInformation, "Wstaw"
        
        Exit Sub
    
    End If

    With ThisWorkbook.Sheets("Database")
        Set rHead = .Range("A1") '<<<< Address should be top left corner of database
        lLst = rHead.CurrentRegion.Rows.Count

        vIn = rHead.Range(Cells(lLst, 1), Cells(lLst, 3)).Formula
        
        For lC = 1 To UBound(vIn, 2)
            If Not vIn(1, lC) Like "=*" Then vIn(1, lC) = ""
        Next lC

        rHead.Range(Cells(lLst, 1), Cells(lLst, 3)).Offset(1, 0).Formula = vIn
    End With

End Sub