PDA

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.

SamT
03-19-2016, 04:52 PM
See post #7

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.

snb
03-20-2016, 06:39 AM
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