Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.newusers
|
|||
|
|||
![]()
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").S elect 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").Resi ze(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").Sele ct 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").Sele ct 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. |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Delete all Rows Macro | Excel Discussion (Misc queries) | |||
Macro to Delete Certain Rows | Excel Discussion (Misc queries) | |||
delete rows using macro | Excel Worksheet Functions | |||
Create a macro to delete rows if value is less than a specified nu | Excel Worksheet Functions | |||
delete rows-macro | Excel Discussion (Misc queries) |