VBA Confirm Message Before Deleting Row

[mackypogi]

Hello guys, I have a macro that can delete an entire row, At the End of the macro It will display a MessageBox Saying "Number of Deleted rows: (no. of rows deleted)". I know this macro is working fine, but my problem is, I want to have a Confirm/MessageBox first, saying "Would you like to delete (no. of rows to delete) Rows?" If Yes is pressed It will delete the rows, and when No is pressed It will End the process.

I hope you guys can help me. I badly need it because macro do not have a UNDO so I want to have a verification first if I have a correct no. of rows to be deleted. Thank you!

Here is my Code.



Sub Delete_Row()
Dim calcmode As Long
Dim ViewMode As Long
Dim myStrings As Variant
Dim FoundCell As Range
Dim I As Long
Dim ws As Worksheet
Dim strToDelete As String
Dim DeletedRows As Long

'for speed purpose
With Application
calcmode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'back to normal view, do this for speed
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
'Turn off Page Breaks, do this for speed
ActiveSheet.DisplayPageBreaks = False

'search strings here
strToDelete = Application.InputBox("Enter value to delete", "Delete Rows", Type:=2)
If strToDelete = "False" Or Len(strToDelete) = 0 Then
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = calcmode
End With
Exit Sub
End If

'make search strings array for more than one
myStrings = Split(strToDelete)

'Loop through selected sheets
For Each ws In ActiveWorkbook.Windows(1).SelectedSheets

'search the values in MyRng
For I = LBound(myStrings) To UBound(myStrings)

Do 'Make the loop

'search the used cell/range in entire sheet
Set FoundCell = ws.UsedRange.Find(What:=myStrings(I), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then Exit Do 'end loop if no result found

FoundCell.EntireRow.Delete 'Delete row
DeletedRows = DeletedRows + 1 'Count deleted rows

Loop

Next I

Next ws

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = calcmode
End With

If DeletedRows = 0 Then
MsgBox "No Match Found!", vbInformation, "Delete Rows Complete"
Else
MsgBox "Number of deleted rows: " & DeletedRows, vbInformation, "Delete Rows Complete"
End If

End Sub

[Admin]

Hi

Welcome to ExcelFox!!

Try


Option Explicit

Sub Delete_Row()
Dim calcmode As Long
Dim ViewMode As Long
Dim myStrings As Variant
Dim FoundCell As Range
Dim I As Long
Dim ws As Worksheet
Dim strToDelete As String
Dim DeletedRows As Long
Dim c As Range
Dim fa As String

'for speed purpose
With Application
calcmode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'back to normal view, do this for speed
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
'Turn off Page Breaks, do this for speed
ActiveSheet.DisplayPageBreaks = False

'search strings here
strToDelete = Application.InputBox("Enter value to delete", "Delete Rows", Type:=2)
If strToDelete = "False" Or Len(strToDelete) = 0 Then
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = calcmode
End With
Exit Sub
End If

'make search strings array for more than one
myStrings = Split(strToDelete)

'Loop through selected sheets
For Each ws In ActiveWorkbook.Windows(1).SelectedSheets

'search the values in MyRng
For I = LBound(myStrings) To UBound(myStrings)
Set c = ws.UsedRange.Find(What:=myStrings(I), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set FoundCell = Nothing
If Not c Is Nothing Then
fa = c.Address
Do 'Make the loop
If FoundCell Is Nothing Then
Set FoundCell = c
Else
Set FoundCell = Union(FoundCell, c)
End If
DeletedRows = DeletedRows + 1 'Count deleted rows
'search the used cell/range in entire sheet
Set c = ws.UsedRange.FindNext(c)
Loop While Not c Is Nothing And c.Address <> fa
End If
Next I
If Not FoundCell Is Nothing Then
If MsgBox("Would you like to delete (" & FoundCell.Areas.Count & ") Rows?", vbQuestion + vbYesNo) = vbYes Then
FoundCell.EntireRow.Delete
End If
End If
Next ws
If DeletedRows Then
MsgBox "Number of deleted rows: " & DeletedRows, vbInformation, "Delete Rows Complete"
Else
MsgBox "No Match Found!", vbInformation, "Delete Rows Complete"
End If

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = calcmode
End With

End Sub

[mackypogi]

Hi Sir,

Thank you for the codes admin!.

It works! but when I click the 'No' in the confirmation MsgBox it still show the number of deleted rows even if it does not delete any rows. It is almost done :)

[mackypogi]

The problem is when I press 'NO'

1102

It shows the MsgBox

1103

Thank you so much for help admin!

[Admin]

HI

OK. See the changes highlighted.


If Not FoundCell Is Nothing Then
If MsgBox("Would you like to delete (" & FoundCell.Areas.Count & ") Rows?", vbQuestion + vbYesNo) = vbYes Then
FoundCell.EntireRow.Delete
Else
GoTo 1
End If
End If
Next ws
If DeletedRows Then
MsgBox "Number of deleted rows: " & DeletedRows, vbInformation, "Delete Rows Complete"
Else
MsgBox "No Match Found!", vbInformation, "Delete Rows Complete"
End If
1:
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = calcmode
End With

[mackypogi]

Hi Admin

The code works! :) thank you so much for your fast response. while exploring it more, I found another problem.

The code loops through different/multiple worksheet that is selected by the user. but using your provided codes when I delete rows from different or MULTIPLE SELECTED WORKSHEETS it only compute the total number of rows in each worksheet. not the total number of rows deleted. You can try it yourself, try to select multiple worksheet and use the macro to delete. Sorry I cannot provide anymore Images. I dont know what happened. I cannot upload anymore :confused:

The problem is with the confirmation MsgBox again. It can only display the total number of rows in each worksheet. but not the total number of rows that should be deleted.

for example:

in Sheet1

MsgBox1 : would you like to delete (1) rows

in Sheet2

MsgBox2 : would you like to delete (2) rows

in Sheet3

MsgBox3 : would you like to delete (3) rows

Last MsgBox
MsgBox4 : number of deleted rows (6)

[Admin]

Hi

That's not correct. I used the variable DeletedRows which is calculating the total number of rows to be deleted on all selected sheets.

Also please be noted that if you select multiple sheets, the deletion happens sheetwise, so the rows count will be for that sheet only.

[mackypogi]

Hi

That's not correct. I used the variable DeletedRows which is calculating the total number of rows to be deleted on all selected sheets.

Also please be noted that if you select multiple sheets, the deletion happens sheetwise, so the rows count will be for that sheet only.


Sir I would like to delete rows from multiple Worksheets. See my Example on Above code.

[Admin]

It deletes. Try yourself first.

[mackypogi]

It deletes. Try yourself first.

You are right sir, It deletes the rows. the problem is, I will get alot of confirmation button if I select many worksheets/tab.

For Example: Im going to delete 'try'

in Sheet1 : try

MsgBox1 : would you like to delete (1) rows?

in Sheet2 : try try

MsgBox2 : would you like to delete (2) rows?

in Sheet3: try try try

MsgBox3 : would you like to delete (3) rows?

Last MsgBox
MsgBox4 : number of deleted rows (6)

[Admin]

Hi

If you are working with multiple sheets, the deletion needs to be done sheetwise so the confirmation.

[mackypogi]

so it cannot be one confirmation message only? if that so, I would like to add the worksheet name on the confirmation message.

for example:

1st confirm MsgBox: would you like to delete (no. of rows) rows in (Sheet1/worksheet name)?

2nd confirm MsgBox: would you like to delete (no. of rows) rows in (Sheet2/worksheet name)?

MsgBox: Total number of rows deleted: (total no. of rows deleted)

[mackypogi]

Hi Admin.

I would like to say thank you for your help. I have made the changes that I needed. I have some changes to the codes you gave me.
Unfortunately, there is one more problem that I encounter and I cannot solve it to my self. The problem is about the [array], the value in input box can be multiple, In short, I use multiple deletion. The problem is, It only deletes the last input/data in the InputBox. In short the multiple deletion is not working, the array is not working.

Here is my code:




Option Explicit

Sub Delete_Row_New()
Dim calcmode As Long
Dim ViewMode As Long
Dim myStrings As Variant
Dim FoundCell As Range
Dim I As Long
Dim ws As Worksheet
Dim strToDelete As String
Dim DeletedRows As Long
Dim c As Range
Dim fa As String

'for speed purpose
With Application
calcmode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'back to normal view, do this for speed
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
'Turn off Page Breaks, do this for speed
ActiveSheet.DisplayPageBreaks = False

'search strings here
strToDelete = Application.InputBox("Enter value to delete", "Delete Rows", Type:=2)
If strToDelete = "False" Or Len(strToDelete) = 0 Then
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = calcmode
End With
Exit Sub
End If

'make search strings array for more than one
myStrings = Split(strToDelete)

'Loop through selected sheets
For Each ws In ActiveWorkbook.Windows(1).SelectedSheets

'search the values in MyRng
For I = LBound(myStrings) To UBound(myStrings)
Set c = ws.UsedRange.Find(What:=myStrings(I), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set FoundCell = Nothing
If Not c Is Nothing Then
fa = c.Address
Do 'Make the loop
If FoundCell Is Nothing Then
Set FoundCell = c
Else
Set FoundCell = Union(FoundCell, c)
End If
DeletedRows = DeletedRows + 1 'Count deleted rows
'search the used cell/range in entire sheet
Set c = ws.UsedRange.FindNext(c)
Loop While Not c Is Nothing And c.Address <> fa
End If
Next I
If Not FoundCell Is Nothing Then
If MsgBox("Would you like to delete (" & FoundCell.Count & ") Rows in " & ws.Name & "?", vbQuestion + vbYesNo) = vbYes Then
FoundCell.EntireRow.Delete
Else
GoTo 1
End If
End If
Next ws

If DeletedRows Then
MsgBox "Total number of deleted rows: " & DeletedRows, vbInformation, "Delete Rows Complete"
Else
MsgBox "No Match Found!", vbInformation, "Delete Rows Complete"
End If
1:
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = calcmode
End With

End Sub

[Admin]

Hi

Try this.


Option Explicit

Dim dic As Object
Dim DeletedRows As Long
Dim Flg As Boolean

Sub Delete_Row_New()

Dim CalcMode As Long
Dim ViewMode As Long
Dim ws As Worksheet
Dim strToDelete As String

'for speed purpose
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'back to normal view, do this for speed
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
'Turn off Page Breaks, do this for speed
ActiveSheet.DisplayPageBreaks = False

'search strings here
strToDelete = Application.InputBox("Enter value to delete", "Delete Rows", Type:=2)
If strToDelete = "False" Or Len(strToDelete) = 0 Then
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
Exit Sub
End If

'Loop through selected sheets
For Each ws In ActiveWorkbook.Windows(1).SelectedSheets

FIND_AND_DELETE ws, Split(strToDelete)
If Flg Then
DeletedRows = 0
Flg = False
GoTo 1
End If
Next

If DeletedRows Then
MsgBox "Total number of deleted rows: " & DeletedRows, vbInformation, "Delete Rows Complete"
Else
MsgBox "No Match Found!", vbInformation, "Delete Rows Complete"
End If
1:
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With

End Sub

Sub FIND_AND_DELETE(ByRef Wksht As Worksheet, ByVal SearchKeys As Variant)

Dim i As Long
Dim c As Range
Dim fa As String

If dic Is Nothing Then
Set dic = CreateObject("scripting.dictionary")
dic.comparemode = 1
Else
dic.RemoveAll
End If

With Wksht
For i = 0 To UBound(SearchKeys)
Set c = .UsedRange.Find(What:=SearchKeys(i), LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not c Is Nothing Then
fa = c.Address
Do 'Make the loop
If Not dic.exists("A" & c.Row) Then
dic.Item("A" & c.Row) = Empty
DeletedRows = DeletedRows + 1
End If
Set c = .UsedRange.FindNext(c)
Loop While Not c Is Nothing And c.Address <> fa
End If
Next
If dic.Count Then
If MsgBox("Would you like to delete (" & dic.Count & ") Rows in " & .Name & "?", vbQuestion + vbYesNo) = vbYes Then
.UsedRange.Range(Join(dic.keys, ",")).EntireRow.Delete
Else
Flg = True
End If
End If
End With

End Sub

[mackypogi]

Hi Admin. Thank you for the codes you provide. :cheers: