Hi there. I have these VBA codes in my worksheet provided by a good member of this forum and would like to tweak it further to suit my current requirement.

With the current VBA, I'm able to insert a new row via a macro button in Sheet 1. Data has to be entered one row at a time to enable the codes to work and when a unique data is identified in Column B, a new row will be added to Sheet 2 & Sheet 3 to accommodate the unique data. The codes will also run on duplicate data but will not create any new row. There is also a delete row button which works vice versa to the insert row button. This button also deletes row one at a time whenever I highlight the cell that will be deleted.

Now, since I'm receiving data from my colleagues in table forms, I’ll just filter the data that I need and copy them into Sheet 1. When I need to enter say 50 rows of data each time I receive them, I’ll insert 50 empty rows with the insert row button then paste the data accordingly. However, the codes doesn't work for "copy and paste” data.

On the other hand, it would be great if there is a dialog box that pops up requesting the number of rows to be inserted instead of adding one row at a time and a delete rows button that works in mass.

Can somebody assist to tweak these codes according to my requirement. The codes are as below. Regards.

Codes in Sheet 1
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim UR As Worksheet
    Dim WVPU As Worksheet
    If Target.Address <> "$B$5" Or Target.Cells.Count > 1 Then Exit Sub
    If Application.CountIf(Columns(2), Target) > 1 Then Exit Sub
    Set UR = Sheets(2)
    Set WVPU = Sheets(3)
    With UR.Range("A6:J6")
        .Insert
        .Offset(-1).FillDown
    End With
    With WVPU.Range("A6:T6")
        .Insert
        .Offset(-1).FillDown
    End With
    UR.Range("A6") = Target
    WVPU.Range("A6") = Target
End Sub
Codes in Module1
Option Explicit
Sub Macro1()
    Dim WRN As Worksheet
 
    Set WRN = Sheets(1)
 
    With WRN.Range("A5:D5")
        .Insert Shift:=xlDown
        .Offset(-1).Interior.ColorIndex = xlNone
    End With
 
    End Sub
Sub Macro2()
    Dim WRN As Worksheet
    Dim UR As Worksheet
    Dim WVPU As Worksheet
    Dim ToDelete As String
    Dim sh As Worksheet
    Dim Confirm As Long
    Set WRN = Sheets(1)
    Set UR = Sheets(2)
    Set WVPU = Sheets(3)
 
    ToDelete = WRN.Cells(ActiveCell.Row, 2)
    If ToDelete <> "" Then
        Confirm = MsgBox("This will delete" & vbCr & _
        "Name: " & WRN.Cells(ActiveCell.Row, 2) & vbCr & _
        "Job: " & WRN.Cells(ActiveCell.Row, 1), vbYesNo)
        If Confirm = vbNo Then Exit Sub
 
        If Application.CountIf(Columns(2), ToDelete) = 1 Then
            If ToDelete <> "" Then
                UR.Columns(1).Find(ToDelete, lookat:=xlWhole).EntireRow.Delete
                WVPU.Columns(1).Find(ToDelete, lookat:=xlWhole).EntireRow.Delete
            End If
        End If
    End If
    ActiveCell.EntireRow.Delete
End Sub