View Full Version : Dialog box, select rows>5, delete in multiple worksheets
jokris
03-17-2016, 07:18 PM
Code below works good for deleting rows on the active worksheet, but I would love to have a couple of changes. I am not good at VBA, this code is a sample from another place. I would like two different codes, one for the current worksheet and one for multiple worksheets.
1. I don't want to be able to delete rows 1-5 for this code. Some kind of dialog box that says: "You can only delete row "6" or below".
Option Explicit
Sub DeleteMe()
Dim Ret As Range, Cl As Range
On Error Resume Next
Set Ret = Application.InputBox("Mark rows to be deleted", "Delete rows", Type:=8)
On Error GoTo 0
ActiveSheet.Unprotect Password:="password"
If Not Ret Is Nothing Then Ret.EntireRow.Delete
ActiveSheet.Protect Password:="password"
End Sub
2. Another similar code as above (delete row 6 or higher) with dialog box and selection, but when I select rows in worksheet A, the same rows in worksheet B and C are also deleted.
mancubus
03-18-2016, 01:46 AM
for 1 sheet
Sub vbax_55475_delete_rows_via_inputbox_single_ws()
With Worksheets("Sheet1") 'change sheet name to suit
.Select
On Error Resume Next
Set Ret = Application.InputBox("Mark rows to be deleted", "Delete rows", Type:=8)
On Error GoTo 0
.Unprotect Password:="password"
If Not Ret Is Nothing Then Ret.EntireRow.Delete
.Protect Password:="password"
End With
End Sub
mancubus
03-18-2016, 01:52 AM
for multiple sheets, same password
Sub vbax_55475_delete_rows_via_inputbox_multiple_wss_same_pass()
Dim ws As Worksheet
For Each ws In Worksheets(Array("Sheet3", "Sheet4", "Sheet6")) 'change sheet names to suit
With ws
.Select
On Error Resume Next
Set Ret = Application.InputBox("Mark rows to be deleted", "Delete rows", Type:=8)
On Error GoTo 0
.Unprotect Password:="password"
If Not Ret Is Nothing Then Ret.EntireRow.Delete
.Protect Password:="password"
End With
Next ws
End Sub
mancubus
03-18-2016, 01:54 AM
for multiple sheets, different passwords
Sub vbax_55475_delete_rows_via_inputbox_multiple_wss_diff_pass()
Dim wsList, passList
Dim i As Long
wsList = Array("Sheet3", "Sheet4", "Sheet6") 'change sheet names to suit
passList = Array("PassWordForSheet3", "PassWordForSheet4", "PassWordForSheet6") 'change passwords to suit
For i = LBound(wsList) To UBound(wsList)
With Worksheets(wsList(i))
.Select
On Error Resume Next
Set Ret = Application.InputBox("Mark rows to be deleted", "Delete rows", Type:=8)
On Error GoTo 0
.Unprotect Password:=passList(i)
If Not Ret Is Nothing Then Ret.EntireRow.Delete
.Protect Password:=passList(i)
End With
Next ws
End Sub
jokris
03-18-2016, 03:43 AM
Thank you mancubus!
Is it possible to make a dialog box appear on each code when people try to delete row 1-5?
for 1 sheet
Sub vbax_55475_delete_rows_via_inputbox_single_ws()
With Worksheets("Sheet1") 'change sheet name to suit
.Select
On Error Resume Next
Set Ret = Application.InputBox("Mark rows to be deleted", "Delete rows", Type:=8)
On Error GoTo 0
.Unprotect Password:="password"
If Not Ret Is Nothing Then Ret.EntireRow.Delete
.Protect Password:="password"
End With
End Sub
mancubus
03-18-2016, 03:48 AM
ah, i missed that bit.
do you mean 'dont let the user select rows for deletion other than rows 1 to 5?
jokris
03-18-2016, 04:01 AM
ah, i missed that bit.
do you mean 'dont let the user select rows for deletion other than rows 1 to 5?
I have important information on row 1-5 so I want them to stay intact :)
But I would like to be able to delete row 6, 7, 8 and so on.
mancubus
03-18-2016, 05:14 AM
try
Sub vbax_55475_delete_rows_via_inputbox_single_ws()
Dim Ret As Range
With Worksheets("Sheet1") 'change sheet name to suit
.Select
On Error Resume Next
Set Ret = Application.InputBox("Mark rows to be deleted", "Delete rows", Type:=8)
On Error GoTo 0
If Ret.Cells(1).Row < 6 Then
MsgBox "Rows 1-5 must not be deleted. Quitting...", vbOKOnly, "Warning!"
Exit Sub
End If
.Unprotect Password:="password"
If Not Ret Is Nothing Then Ret.EntireRow.Delete
.Protect Password:="password"
End With
End Sub
Sub vbax_55475_delete_rows_via_inputbox_multiple_wss_same_pass()
Dim ws As Worksheet
Dim Ret As Range
For Each ws In Worksheets(Array("Sheet3", "Sheet4", "Sheet6")) 'change sheet names to suit
With ws
.Select
On Error Resume Next
Set Ret = Application.InputBox("Mark rows to be deleted", "Delete rows", Type:=8)
On Error GoTo 0
If Ret.Cells(1).Row < 6 Then
MsgBox "Rows 1-5 must not be deleted. Quitting...", vbOKOnly, "Warning!"
Exit Sub
End If
.Unprotect Password:="password"
If Not Ret Is Nothing Then Ret.EntireRow.Delete
.Protect Password:="password"
End With
Next ws
End Sub
Sub vbax_55475_delete_rows_via_inputbox_multiple_wss_diff_pass()
Dim wsList, passList
Dim i As Long
Dim Ret As Range
wsList = Array("Sheet3", "Sheet4", "Sheet6") 'change sheet names to suit
passList = Array("PassWordForSheet3", "PassWordForSheet4", "PassWordForSheet6") 'change passwords to suit
For i = LBound(wsList) To UBound(wsList)
With Worksheets(wsList(i))
.Select
On Error Resume Next
Set Ret = Application.InputBox("Mark rows to be deleted", "Delete rows", Type:=8)
On Error GoTo 0
If Ret.Cells(1).Row < 6 Then
MsgBox "Rows 1-5 must not be deleted. Quitting...", vbOKOnly, "Warning!"
Exit Sub
End If
.Unprotect Password:=passList(i)
If Not Ret Is Nothing Then Ret.EntireRow.Delete
.Protect Password:=passList(i)
End With
Next ws
End Sub
jokris
03-18-2016, 08:36 AM
When I delete on multiple pages (same password), the code asks me to select rows first on Sheet3, then jumps to Sheet4 and asks me again, finally asking me the same on Sheet6.
Is it possible to make it delete on all three pages without jumping to Sheet 4 and 6 and asking me the same question?
So that if I delete row 8 on Sheet3, row 8 on Sheet4 and Sheet6 will also be deleted.
Also making me end up on Sheet3 again when the procedure is finished.
Sub vbax_55475_delete_rows_via_inputbox_multiple_wss_same_pass()
Dim ws As Worksheet
Dim Ret As Range
For Each ws In Worksheets(Array("Sheet3", "Sheet4", "Sheet6")) 'change sheet names to suit
With ws
.Select
On Error Resume Next
Set Ret = Application.InputBox("Mark rows to be deleted", "Delete rows", Type:=8)
On Error GoTo 0
If Ret.Cells(1).Row < 6 Then
MsgBox "Rows 1-5 must not be deleted. Quitting...", vbOKOnly, "Warning!"
Exit Sub
End If
.Unprotect Password:="password"
If Not Ret Is Nothing Then Ret.EntireRow.Delete
.Protect Password:="password"
End With
Next ws
End Sub
mancubus
03-18-2016, 04:01 PM
Sub vbax_55475_delete_rows_via_inputbox_multiple_wss_same_pass()
Dim ws As Worksheet
Dim Ret As Range
On Error Resume Next
Set Ret = Application.InputBox("Mark rows to be deleted", "Delete rows", Type:=8)
On Error GoTo 0
If Not Ret Is Nothing Then
If Ret.Cells(1).Row < 6 Then
MsgBox "Rows 1-5 must not be deleted. Quitting...", vbOKOnly, "Warning!"
Exit Sub
End If
For Each ws In Worksheets(Array("Sheet3", "Sheet4", "Sheet6")) 'change sheet names to suit
With ws
.Unprotect Password:="password"
Ret.EntireRow.Delete
.Protect Password:="password"
End With
Next ws
End If
End Sub
jokris
03-18-2016, 08:57 PM
The code deletes the selected rows at Sheet3, but when it comes to Sheet4 I receive Run-time Error '424': Object required, and the code stops working
Sub vbax_55475_delete_rows_via_inputbox_multiple_wss_same_pass()
Dim ws As Worksheet
Dim Ret As Range
On Error Resume Next
Set Ret = Application.InputBox("Mark rows to be deleted", "Delete rows", Type:=8)
On Error GoTo 0
If Not Ret Is Nothing Then
If Ret.Cells(1).Row < 6 Then
MsgBox "Rows 1-5 must not be deleted. Quitting...", vbOKOnly, "Warning!"
Exit Sub
End If
For Each ws In Worksheets(Array("Sheet3", "Sheet4", "Sheet6")) 'change sheet names to suit
With ws
.Unprotect Password:="password"
Ret.EntireRow.Delete
.Protect Password:="password"
End With
Next ws
End If
End Sub
mancubus
03-19-2016, 11:45 AM
dont quote previous messages or codes pls.
as i almost never use select statement, sometimes i hardly remember its use and limitations.
use below. it includes favorite 'selecting' as well.
Sub vbax_55475_delete_rows_via_inputbox_multiple_wss_same_pass()
Dim ws As Worksheet
Dim RowsToDel As Range
Dim RowNums
Dim i As Long
On Error Resume Next
Set RowsToDel = Application.InputBox("Mark rows to be deleted", "Delete rows", Type:=8)
On Error GoTo 0
If Not RowsToDel Is Nothing Then
If RowsToDel.Cells(1).Row < 6 Then
MsgBox "Rows 1-5 must not be deleted. Quitting...", vbOKOnly, "Warning!"
Exit Sub
End If
RowNums = Split(RowsToDel.Address(0, 0), ",")
For Each ws In Worksheets(Array("Sheet3", "Sheet4", "Sheet6")) 'change sheet names to suit
With ws
.Unprotect Password:="password"
For i = UBound(RowNums) To LBound(RowNums) Step -1
.Rows(RowNums(i)).Delete
Next
.Protect Password:="password"
End With
Next ws
End If
End Sub
jokris
03-19-2016, 12:39 PM
I tried your new code but received runtime error 1004 at
.Rows(RowNums(i)).Delete
mancubus
03-19-2016, 01:13 PM
worked for me. check the attachment.
mikerickson
03-19-2016, 01:46 PM
Why is there the "cannot delete row 6 or higher" restriction?
If I wanted row 6 deleted, I'd just delete row 1 and then delete the (new) row 5.
mancubus
03-20-2016, 05:19 AM
if the deletion process will depend on the user's selection, it means rows to be deleted may/will change each time you run the code.
and that means deletion will be based on some conditions.
try to analyze those conditions and adopt the code above to these conditions.
googling "delete rows based on condition" will give you thousands of examples.
in my projects, rows to be deleted are filtered based on column values and visible rows under header row are deleted.
Why not ?
Sub M_snb()
Set rtbd = Intersect(Application.InputBox("Mark rows to be deleted", "Delete rows", Type:=8), Rows(6).Resize(Rows.Count - 6))
If Not rtbd Is Nothing Then rtbd.Delete
End Sub
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.