VBA code deleting everything not just rows with specified values. Please help.

[Mitchell_Collen via OfficeKB.com]

Hi VBA Professionals.
Please see my code. I am trying to only delete rows in an excel sheet where
the value is equal to each string value provided below. However when I run
this macro it deletes everything. I don't know what I am doing wrong. I won't
lie. I am no programmer. Will you please help me with this?
Thanks, Misty

Sub Macro1()
' Keyboard Shortcut: Ctrl+d
'Sub DelEmptyRow()
Rng = Selection.Rows.Count
ActiveCell.Offset(0, 0).Select
Application.ScreenUpdating = False

For i = 1 To Rng
If ActiveCell.Value = "Outpatient Chronic" Then
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If

If ActiveCell.Value = "Dialysis Treatments" Then
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If

If ActiveCell.Value = "Medications" Then
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If

If ActiveCell.Value = "Ferrlecit*" Then
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If

If ActiveCell.Value = "Zemplar*" Then
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If

If ActiveCell.Value = "Cathflo*" Then
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If

If ActiveCell.Value = "Clarity" Then
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If

Next i
Application.ScreenUpdating = True
End Sub

 

[JW]

When deleting rows, it is best to start at the bottom and work your
way up.

This is one way of doing this. This example is checking the cells
within column A and comparing them to each of the values stored in the
valChecks array. If a match is found, the entire row is deleted.

Sub Macro1()
' Keyboard Shortcut: Ctrl+d
Dim valChecks As Variant, rng As Long
rng = Cells(Rows.Count, 1).End(xlUp).Row
valChecks = Array("Outpatient Chronic", _
"Dialysis Treatments", "Medications", _
"Ferrlecit*", "Zemplar*", _
"Cathflo*", "Clarity")
Application.ScreenUpdating = False
For i = rng To 2 Step -1
For j = LBound(valChecks) To UBound(valChecks)
If Cells(i, 1).Value = valChecks(j) Then
Cells(i, 1).EntireRow.Delete
Exit For
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub

 

[JE McGimpsey]

One possibility:

Public Sub DeleteSpecificRows()
Dim rCell As Range
Dim rDelete As Range
Dim vTargets As Variant
Dim i As Long

vTargets = Array("outpatient chronic", "dialysis treatments", _
"Medications", "Ferrlecit*", "Zemplar*", "Cathflo*", "Clarity")
For Each rCell In Range("A1:A" & _
Range("A" & Rows.Count).End(xlUp).Row)
With rCell
For i = LBound(vTargets) To UBound(vTargets)
If LCase(.Text) = vTargets(i) Then
If rDelete Is Nothing Then
Set rDelete = .Cells
Else
Set rDelete = Union(rDelete, .Cells)
End If
End If
Next i
End With
Next rCell
If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
End Sub

 

[Mitchell_Collen via OfficeKB.com]

Wow thanks! It works!
I really envy your gift with programming logic!

-Misty

One possibility:

Public Sub DeleteSpecificRows()
Dim rCell As Range
Dim rDelete As Range
Dim vTargets As Variant
Dim i As Long

vTargets = Array("outpatient chronic", "dialysis treatments", _
"Medications", "Ferrlecit*", "Zemplar*", "Cathflo*", "Clarity")
For Each rCell In Range("A1:A" & _
Range("A" & Rows.Count).End(xlUp).Row)
With rCell
For i = LBound(vTargets) To UBound(vTargets)
If LCase(.Text) = vTargets(i) Then
If rDelete Is Nothing Then
Set rDelete = .Cells
Else
Set rDelete = Union(rDelete, .Cells)
End If
End If
Next i
End With
Next rCell
If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
End Sub

Hi VBA Professionals.
Please see my code. I am trying to only delete rows in an excel sheet where

[quoted text clipped - 56 lines]

Application.ScreenUpdating = True
End Sub

 

[JE McGimpsey]

Note that to work completely, the values in the array should all be
lower case...