PDA

View Full Version : Confirm Message Before Deleting Rows



mackypogi
08-06-2013, 09:16 PM
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

Ringhal
08-07-2013, 02:49 AM
Code hasn't been tested or error checked.

Sub Delete_Row()
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String

' Promt
strPrompt = "Would you like to delete " & DeletedRows & " Rows?"


' Dialog's Title
strTitle = "Delete Rows Complete"

'Display MessageBox
iRet = MsgBox(strPrompt, vbYesNo, strTitle)

' Check pressed button
If iRet = vbNo Then
Exit Sub
Else
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
End If
End Sub