Bernie,

The SAVESTR is copied from Cells B2 thru B11 on Sheet1. I need to loop
through each cell in Column I:I looking for a match on SAVESTR. If a match
is found, the ROW is kept, otherwise it is deleted. On the First Run for the
Hardware sheet it works, however when it moves to Hardware (2), and
SAVESTR(2), it doesn't do the matchup.

This script work fine on the first sheet or if I run Multiple copies.
However I am tring to slim down my Macro sizes.

"Bernie Deitrick" wrote:

What is it that you want to do? A better description would help - it seems like your SAVESTR is
tied to the specific sheet - or do you want to loop through those as well?

HTH,
Bernie
MS Excel MVP


"VexedFist" wrote in message
...
Bernie,

I think I was sleeping, thanks for catching that.

However it still does NOT delete the unwanted Cells on Hardware sheets 2
thru 11?
the first sheet (Hardware) works, but the others do Not.
Since it keys off of SAVESTR, could that be an issue?

Your help is greatly appreiciated


"Bernie Deitrick" wrote:

Perhaps because you did not increment your index value?

myWorkseheets(2) = "Hardware (2)"
myWorkseheets(2) = "Hardware (3)"
myWorkseheets(2) = "Hardware (4)"
myWorkseheets(2) = "Hardware (5)"
myWorkseheets(2) = "Hardware (6)"
myWorkseheets(2) = "Hardware (7)"
myWorkseheets(2) = "Hardware (8)"
myWorkseheets(2) = "Hardware (9)"
myWorkseheets(2) = "Hardware (10)"

myWorkseheets(2) = "Hardware (2)"
myWorkseheets(3) = "Hardware (3)"
myWorkseheets(4) = "Hardware (4)"
myWorkseheets(5) = "Hardware (5)"
myWorkseheets(6) = "Hardware (6)"
myWorkseheets(7) = "Hardware (7)"
myWorkseheets(8) = "Hardware (8)"
myWorkseheets(9) = "Hardware (9)"
myWorkseheets(10) = "Hardware (10)"

HTH,
Bernie
MS Excel MVP


"VexedFist" wrote in message
oups.com...
Any Idea why this only works for the First Worksheet (Hardware)?


Sub DupSheets()

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
SAVESTR(1) = Worksheets("Sheet1").Range("B2").Value
SAVESTR(2) = Worksheets("Sheet1").Range("B3").Value
SAVESTR(3) = Worksheets("Sheet1").Range("B4").Value
SAVESTR(4) = Worksheets("Sheet1").Range("B5").Value
SAVESTR(5) = Worksheets("Sheet1").Range("B6").Value
SAVESTR(6) = Worksheets("Sheet1").Range("B7").Value
SAVESTR(7) = Worksheets("Sheet1").Range("B8").Value
SAVESTR(8) = Worksheets("Sheet1").Range("B9").Value
SAVESTR(9) = Worksheets("Sheet1").Range("B10").Value
SAVESTR(10) = Worksheets("Sheet1").Range("B11").Value
SAVESTR(11) = Worksheets("Sheet1").Range("B12").Value
myWorkseheets(0) = "Sheet1"
myWorkseheets(1) = "Hardware"
myWorkseheets(2) = "Hardware (2)"
myWorkseheets(2) = "Hardware (3)"
myWorkseheets(2) = "Hardware (4)"
myWorkseheets(2) = "Hardware (5)"
myWorkseheets(2) = "Hardware (6)"
myWorkseheets(2) = "Hardware (7)"
myWorkseheets(2) = "Hardware (8)"
myWorkseheets(2) = "Hardware (9)"
myWorkseheets(2) = "Hardware (10)"
myWorkseheets(11) = "Hardware (11)"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Windows("9006 Port Report.xls").Activate
For iCount = 0 To 11
Worksheets(myWorkseheets(iCount)).Select
Worksheets(myWorkseheets(iCount)).Columns("I:I").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("I1").Resi ze(Range( _
"I" & 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
Worksheets(myWorkseheets(iCount)).Range("B1").Sele ct
Selection.EntireRow.Insert
Worksheets(myWorkseheets(iCount)).Range("N1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("O1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("P1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("Q1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("R1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("S1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("T1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("U1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("V1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Worksheets(myWorkseheets(iCount)).Range("W1").Form ulaR1C1 =
"=SUM(R[1]C:R[500]C)"
Else
Columns("A:A").ColumnWidth = 2
End If
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
ChDir "C:\Temp Data Files\Reconfigured Data"
ActiveWorkbook.SaveAs Filename:="C:\Temp Data Files
\Reconfigured Data\9006 Port Report.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Sheets("Hardware").Select
Next iCount
Application.ScreenUpdating = False
End Sub


Your assistance is really appreciated.