Macro does Not Delete Rows???

[MyFlight]

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.

 

[SkipVought]

Hi,

It would seem to me that this could be much simpler via the AutoFilter using a NOT EQUALS criteria, since you seem to be looking for only one string on each sheet, or am I missing something?

Skip,

_[red][/red]

 

[MyFlight]

Skip,

I am trying to do this all with VBA so it can be automated. I user this and about 50 other Mscros to import Switch Data and Auto Generate Reports.

I am trying to make it hands-off, the peopl that use this don't know Excel at all. Plus I am trying to stink to a certian output format for our customers.

If you have any furtehr questions please let me know.

 

[SkipVought]

I'm not suggesting that it cannot be done via VBA.

Turn on your macro recorder and perform the operations I outlined. Then customize to fit.

Skip,

_[red][/red]

 

[MyFlight]

Skip,

if I use this:
Columns("X:X").AutoFilter Field:=1, Criteria1:="OPTI"
that will just Hide the other Cells.
Likewise with the Not Equals, it won't delet them?

or am I totally missing something here?

 

[SkipVought]

with Worksheets(myWorkseheets(iCount))
  .Columns("X:X").AutoFilter Field:=1, Criteria1:=SAVESTR(iCount)
  .cells.specialcells(xlcelltypevisible).entirerow.delete
end with

Skip,

_[red][/red]