Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Macro does Not Delete Rows???

Status
Not open for further replies.

MyFlight

Technical User
Feb 4, 2002
193
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.
 




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,

[glasses] [red][/red]
[tongue]
 
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.
 



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,

[glasses] [red][/red]
[tongue]
 
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?

 



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


Skip,

[glasses] [red][/red]
[tongue]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top