VBA Confirm Message Before Deleting Row

[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.