My Macro does NOT Delete ROWS??

[VexedFist]

My Macro does not DELETE the ROWS from the specified Worksheet whene SAVESTR
is NOT Found.

If SAVESTR is found it deletes the other ROWS. However I need to be left
with a blank sheet if SAVESTR is not found in the specifed column.

Sub DupDigitalSheets()
'
' DupDigitalSheets Macro
' Macro Created On 4/12/2007
'

'
Dim myWorkseheets(11) As String
Dim SAVESTR(11) As String
Dim iCount As Integer
Dim myRange As Range
Dim cell As Range
Dim delRange As Range
Const startRptName = "9006 "
Const stopRptName = " Report.xls"
SAVESTR(0) = "EXTVCML"
SAVESTR(1) = "FICTICS"
SAVESTR(2) = "KYSETDY"
SAVESTR(3) = "KYSETJR"
SAVESTR(4) = "OPSLMA"
SAVESTR(5) = "OPST1"
SAVESTR(6) = "OPTI"
SAVESTR(7) = "PHANTOM"
SAVESTR(8) = "RP4327"
SAVESTR(9) = "RPHONE"
SAVESTR(10) = "SADCM"
myWorkseheets(0) = "Extvcml"
myWorkseheets(1) = "FICTICS"
myWorkseheets(2) = "KYSETDY"
myWorkseheets(3) = "KYSETJR"
myWorkseheets(4) = "OPSLMA"
myWorkseheets(5) = "OPST1"
myWorkseheets(6) = "OptieSets"
myWorkseheets(7) = "PHANTOM"
myWorkseheets(8) = "RP4327"
myWorkseheets(9) = "RPHONE"
myWorkseheets(10) = "SADCMs"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For iCount = 0 To 10
Windows("9006 Digital Line Report.xls").Activate
Worksheets(myWorkseheets(iCount)).Select
Worksheets(myWorkseheets(iCount)).Columns("X:X").Select
On Error Resume Next
Selection.Find(What:=SAVESTR(iCount), After:=ActiveCell,
LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
If Err.Number <> 91 And Err.Number <> 0 Then
MsgBox "Unresolved Error"
Exit Sub
End If
If ActiveCell.Row > 1 Then
Set myRange =
Worksheets(myWorkseheets(iCount)).Range("X1").Resize(Range( _
"X" & Rows.Count).End(xlUp).Row, 1)
For Each cell In myRange
If cell.Value <> SAVESTR(iCount) Then
If delRange Is Nothing Then
Set delRange = cell
Else
Set delRange = Union(delRange, cell)
End If
End If
Next cell
If Not delRange Is Nothing Then delRange.EntireRow.Delete
Set delRange = Nothing
Worksheets(myWorkseheets(iCount)).Range("B1").Select
Worksheets(myWorkseheets(iCount)).Move
ChDir "C:\Temp Data Files\Reconfigured Data"
ActiveWorkbook.SaveAs Filename:= _
startRptName + myWorkseheets(iCount) + stopRptName,
FileFormat:= _
xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWindow.WindowState = xlMinimized
Else
Worksheets(myWorkseheets(iCount)).Range("B1").Select
Worksheets(myWorkseheets(iCount)).Move
ChDir "C:\Temp Data Files\Reconfigured Data"
ActiveWorkbook.SaveAs Filename:= _
startRptName + myWorkseheets(iCount) + stopRptName,
FileFormat:= _
xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWindow.WindowState = xlMinimized
End If
Next iCount
Application.ScreenUpdating = False
End Sub


Any assistance will be appreciated.

 

[Don Guillett]

Pls post in ONE group only