Hi
If you are working with multiple sheets, the deletion needs to be done sheetwise so the confirmation.
Printable View
Hi
If you are working with multiple sheets, the deletion needs to be done sheetwise so the confirmation.
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)
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:
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
Hi
Try this.
Code: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
Hi Admin. Thank you for the codes you provide. :cheers: