Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Running Macro on Multiple Worksheets
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 18
Default Running Macro on Multiple Worksheets
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.

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5,441
Default Running Macro on Multiple Worksheets
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.



Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 10
Default Running Macro on Multiple Worksheets
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.




Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5,441
Default Running Macro on Multiple Worksheets
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.






Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 10
Default Running Macro on Multiple Worksheets
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.







Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5,441
Default Running Macro on Multiple Worksheets
VF,

Change

If Not delRange Is Nothing Then delRange.EntireRow.Delete

to

If Not delRange Is Nothing Then
delRange.EntireRow.Delete
Set delRange = Nothing
End If

HTH,
Bernie
MS Excel MVP


"VexedFist" wrote in message
...
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.









Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 10
Default Running Macro on Multiple Worksheets
Bernie,

That did the Trick.
IS there an easy way to do this with my other worksheets?
the problem I have is the Worksheet names are all different.
The SAVESTR is NOT referenced in a Cell, I aassume the below would work:

SAVESTR(1) = "SomeText Value 1"
SAVESTR(2) = "SomeOtherText"
SAVESTR(3) = "Even More Text"
myWorkseheets(1) = "Digital Phones"
myWorkseheets(2) = "Analog Phones"
myWorkseheets(3) = "Digital Trunks"

Your thoughts would be appreciated



"Bernie Deitrick" wrote:

VF,

Change

If Not delRange Is Nothing Then delRange.EntireRow.Delete

to

If Not delRange Is Nothing Then
delRange.EntireRow.Delete
Set delRange = Nothing
End If

HTH,
Bernie
MS Excel MVP


"VexedFist" wrote in message
...
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.










Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
how do you calculate a running balance in multiple worksheets? strawberryangel83 Excel Worksheet Functions 5 November 4th 08 02:41 PM
Having a formula provide a running total from multiple worksheets sisko101 Excel Worksheet Functions 3 July 7th 06 10:06 PM
Running Macro/VBA in multiple worksheets. YellowBird Excel Programming 9 April 9th 06 05:25 AM
VBA to consolidate multiple worksheets to 1 worksheet in running sequence chongchingsoo[_5_] Excel Programming 0 November 11th 04 02:52 PM
VBA to consolidate multiple worksheets to 1 worksheet in running sequence chongchingsoo[_4_] Excel Programming 1 November 11th 04 02:27 PM


All times are GMT +1. The time now is 02:40 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement