wilsonyeoh
New Member
- Joined
- May 25, 2009
- Messages
- 17
Does anyone have codes to insert and delete multiple rows. I need to run a macro where a dialog box pops up requesting number of rows to insert and delete. Can anyone assist.
[COLOR="Blue"]Sub[/COLOR] MG30May14
[COLOR="Blue"]Dim[/COLOR] Rng [COLOR="Blue"]As[/COLOR] Range, Num [COLOR="Blue"]As[/COLOR] [COLOR="Blue"]String,[/COLOR] ans [COLOR="Blue"]As[/COLOR] [COLOR="Blue"]Integer[/COLOR]
[COLOR="Blue"]On[/COLOR] [COLOR="Blue"]Error[/COLOR] [COLOR="Blue"]Resume[/COLOR] [COLOR="Blue"]Next[/COLOR]
[COLOR="Blue"]Set[/COLOR] Rng = Application.InputBox(prompt:="Please [COLOR="Blue"]Select[/COLOR] Start Row ", Title:="Insert Rows", Type:=8)
Num = Application.InputBox(prompt:="Please Insert Number of Rows", Title:="Insert Rows", Type:=1)
[COLOR="Blue"]If[/COLOR] Num = False [COLOR="Blue"]Then[/COLOR] [COLOR="Blue"]Exit[/COLOR] [COLOR="Blue"]Sub[/COLOR]
ans = MsgBox("Click Yes for ""Insert"", No for ""Delete""", vbYesNo + vbInformation)
[COLOR="Blue"]If[/COLOR] ans = vbYes [COLOR="Blue"]Then[/COLOR]
Rng.Resize(Num).EntireRow.Insert
[COLOR="Blue"]ElseIf[/COLOR] ans = vbNo [COLOR="Blue"]Then[/COLOR]
Rng.Resize(Num).EntireRow.Delete
[COLOR="Blue"]End[/COLOR] [COLOR="Blue"]If[/COLOR]
[COLOR="Blue"]End[/COLOR] [COLOR="Blue"]Sub[/COLOR]
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("Worksheet Menu bar").Controls("Delete Rows").Delete
Application.CommandBars("Worksheet Menu bar").Controls("Insert Rows").Delete
On Error GoTo 0
End Sub
Private Sub Workbook_Open()
Dim cControl As CommandBarButton
Set cControl = Application.CommandBars("Worksheet Menu bar").Controls.Add
With cControl
.Caption = "&Delete Rows"
.Style = msoButtonCaption
.OnAction = "Del"
End With
Set cControl = Application.CommandBars("Worksheet Menu bar").Controls.Add
With cControl
.Caption = "&Insert Rows"
.Style = msoButtonCaption
.OnAction = "Ins"
End With
End Sub
Sub Del()
Dim Rng As Range, Num As String
On Error Resume Next
Set Rng = Application.InputBox(prompt:="Please Select Start Row ", Title:="Delete Rows", Type:=8)
If Split(Rng.Address, "$")(2) < 5 Then
MsgBox "Please choose a Number Greater than 4"
Exit Sub
End If
Num = Application.InputBox(prompt:="Please Insert Number of Rows", Title:="Delete Rows", Type:=1)
If Num = False Then Exit Sub
Rng.Resize(Num).EntireRow.Delete
End Sub
Sub Ins()
Dim Rng As Range, Num As String
On Error Resume Next
Set Rng = Application.InputBox(prompt:="Please Select Start Row ", Title:="Insert Rows", Type:=8)
If Split(Rng.Address, "$")(2) < 5 Then
MsgBox "Please choose a Number Greater than 4"
Exit Sub
End If
Num = Application.InputBox(prompt:="Please Insert Number of Rows", Title:="Insert Rows", Type:=1)
If Num = False Then Exit Sub
Rng.Resize(Num).EntireRow.Insert
End Sub
Private [COLOR="Blue"]Sub[/COLOR] CommandButton1_Click()
[COLOR="Blue"]Dim[/COLOR] Num [COLOR="Blue"]As[/COLOR] [COLOR="Blue"]Integer[/COLOR]
Num = Application.InputBox(prompt:="Please Insert Number of Rows", Title:="Insert Rows", Type:=1)
[COLOR="SeaGreen"][B] 'Change this Line, at end, for "Delete" in Delete Code[/B][/COLOR]
Rows(5).Resize(Num).EntireRow.Insert
[COLOR="Blue"]End[/COLOR] [COLOR="Blue"]Sub[/COLOR]
[COLOR="Blue"]End[/COLOR] [COLOR="Blue"]Sub[/COLOR]
Run the first bit of the "ThisWorkBook" code to delete the new menus items.
Change the Command Button and "Insert/Delete" to suit.