mackypogi
09-17-2013, 09:53 AM
Hi I have a macro that can delete rows, I have a problem with my macro because sometimes when I used it I get a Run-time error '13' Type mismatch but sometimes it is working. I don't know why sometimes I get this error, besides I am using almost the same template everytime. It works in some template, and sometimes it doesnt work, Here is my code below. I hope you guys can help me. thank you so much.
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
If Not FoundCell Is Nothing Then
If MsgBox("Would you like to delete (" & FoundCell.Count & ") rows of " & FoundCell & " in " & ws.Name & " tab?", vbQuestion + vbYesNo) = vbYes Then
FoundCell.EntireRow.Delete
Else
GoTo 1
End If
End If
Next i
Next ws
If DeletedRows Then
MsgBox "Total number of deleted rows: " & DeletedRows, vbInformation, "Delete Rows Complete"
Else
MsgBox "No Match Found!", vbInformation, "Error Occured"
End If
1:
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub
The Error comes in this line
If MsgBox("Would you like to delete (" & FoundCell.Count & ") rows of " & FoundCell & " in " & ws.Name & " tab?", vbQuestion + vbYesNo) = vbYes Then
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
If Not FoundCell Is Nothing Then
If MsgBox("Would you like to delete (" & FoundCell.Count & ") rows of " & FoundCell & " in " & ws.Name & " tab?", vbQuestion + vbYesNo) = vbYes Then
FoundCell.EntireRow.Delete
Else
GoTo 1
End If
End If
Next i
Next ws
If DeletedRows Then
MsgBox "Total number of deleted rows: " & DeletedRows, vbInformation, "Delete Rows Complete"
Else
MsgBox "No Match Found!", vbInformation, "Error Occured"
End If
1:
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub
The Error comes in this line
If MsgBox("Would you like to delete (" & FoundCell.Count & ") rows of " & FoundCell & " in " & ws.Name & " tab?", vbQuestion + vbYesNo) = vbYes Then