PDA

View Full Version : [SOLVED] Loop thru worksheets and run macro



austenr
05-11-2005, 10:47 AM
There is probable a simple answer to this but I have to ask. I have a routine that loops through each sheet in the workbook and I want to execute the same macro in each sheet. The macro works on the first sheet and then stops.


Option Compare Text

Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
DetermineCoverageTypes
Next I
End Sub
Sub DetermineCoverageTypes()
'Checks to see if the value in column G is = previous row
'If so process next row, else, determine coverage types
Dim s, Tempss, TempMem, TempFam, singlecntr, empspcntr, famcntr, _
empchcntr As Integer
' Initialize counters
singlecntr = 0
empspcntr = 0
famcntr = 0
empchcntr = 0
Row = 2
For s = 2 To 1081
Tempss = Range("G" & s - 1).Value
TempMem = Range("I" & s - 1).Value
'Checks to see if the EE social on this line is <> to the one on the previous line
With Range("G" & s)
If .Value <> Tempss Then
TempFam = 0
TempMem = ""
End If
member = .Offset(, 2)
If member <> TempMem Then
Select Case member
Case Is = "Self"
TempFam = TempFam + 1
Case Is = "Spouse"
TempFam = TempFam + 2
Case Is = "Child"
TempFam = TempFam + 4
End Select
End If
If .Offset(1, 0) <> .Offset(0, 0) Then
Select Case TempFam
Case Is = 1
coverage = "Only"
singlecntr = singlecntr + 1
Case Is = 3
coverage = "Spouse"
empspcntr = empspcntr + 1
Case Is = 5
coverage = "Child"
empchcntr = empchcntr + 1
Case Is = 7
coverage = "Family"
famcntr = famcntr + 1
End Select
.Offset(0, -3).Formula = "Self " & coverage
End If
End With
Next s
Range("M20").Value = singlecntr
Range("M21").Value = empspcntr
Range("M22").Value = empchcntr
Range("M23").Value = famcntr
End Sub

Zack Barresse
05-11-2005, 11:15 AM
Hi Austen,

You should think about passing the workbook object off to the sub procedure as well. ...


Option Explicit
Option Compare Text

Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
DetermineCoverageTypes Worksheets(I)
Next I
End Sub

Sub DetermineCoverageTypes(ws As Worksheet)
'Checks to see if the value in column G is = previous row
'If so process next row, else, determine coverage types
Dim s, Tempss, TempMem, TempFam, singlecntr, empspcntr, famcntr, _
empchcntr As Integer
' Initialize counters
singlecntr = 0
empspcntr = 0
famcntr = 0
empchcntr = 0
Row = 2
For s = 2 To 1081
Tempss = ws.Range("G" & s - 1).Value
TempMem = ws.Range("I" & s - 1).Value
'Checks to see if the EE social on this line is <> to the one on the previous line
With ws.Range("G" & s)
If .Value <> Tempss Then
TempFam = 0
TempMem = ""
End If
member = .Offset(, 2)
If member <> TempMem Then
Select Case member
Case Is = "Self"
TempFam = TempFam + 1
Case Is = "Spouse"
TempFam = TempFam + 2
Case Is = "Child"
TempFam = TempFam + 4
End Select
End If
If .Offset(1, 0) <> .Offset(0, 0) Then
Select Case TempFam
Case Is = 1
coverage = "Only"
singlecntr = singlecntr + 1
Case Is = 3
coverage = "Spouse"
empspcntr = empspcntr + 1
Case Is = 5
coverage = "Child"
empchcntr = empchcntr + 1
Case Is = 7
coverage = "Family"
famcntr = famcntr + 1
End Select
.Offset(0, -3).Formula = "Self " & coverage
End If
End With
Next s
ws.Range("M20").Value = singlecntr
ws.Range("M21").Value = empspcntr
ws.Range("M22").Value = empchcntr
ws.Range("M23").Value = famcntr
End Sub

SR22Mike
05-11-2005, 11:16 AM
Hi,

I've used "Sheets.Count" in past and "Sheets(I).Select" to do, what I think you're doing.

I'm sure there's a For Each that'll work too, but within your existing code, I'm guessing that this will work.

Mike

Zack Barresse
05-11-2005, 11:28 AM
Hey Mike, you're right, that would work. The problem is the references like this ..


Range("M20").Value = singlecntr

They are not explicitly set references so the assumption by Excel is to do this on the ActiveSheet. If you Activate/Select the sheet, it will work. Although it's generally good programming practices to not Select or Activate too many things - if at all - in lieu of performance degradation/compromise. That's why I suggested passing off the variable as an object to the Procedure and declaring each line (range object) with this explicit reference. E.g ...


ws.Range("M20").Value = singlecntr

austenr
05-11-2005, 12:19 PM
Hi Zack...Get a 424 runtime error when I run this...

Killian
05-11-2005, 12:48 PM
Hi all,


I'm sure there's a For Each that'll work too

Mike makes a good point. It might be prefeable to iterate thru the worksheets collection to do this, passing the current item to the procedure as Zack suggested.


Sub WorksheetLoop()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
DetermineCoverageTypes ws
Next
End Sub

austenr
05-11-2005, 12:56 PM
That worked great. Now I need to find out how to do the totals on each page. Tried Firefytr's suggestion but cannot get it to work.
:help

austenr
05-11-2005, 02:16 PM
Hmmm. Had this Working to Loop through the worksheets now it stops after the first one.


Option Compare Text

Sub WorksheetLoop()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
DetermineCoverageTypes
Next
End Sub

Sub DetermineCoverageTypes()
'Checks to see if the value in column G is = previous row
'If so process next row, else, determine coverage types
Dim s, Tempss, TempMem, TempFam, singlecntr, empspcntr, famcntr, _
empchcntr As Integer
Dim ws As Worksheet
' Initialize counters
singlecntr = 0
empspcntr = 0
famcntr = 0
empchcntr = 0
Row = 2
For s = 2 To 1081
Tempss = Range("G" & s - 1).Value
TempMem = Range("I" & s - 1).Value
'Checks to see if the EE social on this line is <> to the one on the previous line
With Range("G" & s)
If .Value <> Tempss Then
TempFam = 0
TempMem = ""
End If
member = .Offset(, 2)
If member <> TempMem Then
Select Case member
Case Is = "Self"
TempFam = TempFam + 1
Case Is = "Spouse"
TempFam = TempFam + 2
Case Is = "Child"
TempFam = TempFam + 4
End Select
End If
If .Offset(1, 0) <> .Offset(0, 0) Then
Select Case TempFam
Case Is = 1
coverage = "Only"
singlecntr = singlecntr + 1
Case Is = 3
coverage = "Spouse"
empspcntr = empspcntr + 1
Case Is = 5
coverage = "Child"
empchcntr = empchcntr + 1
Case Is = 7
coverage = "Family"
famcntr = famcntr + 1
End Select
.Offset(0, -3).Formula = "Self " & coverage
End If
End With
Next s
'Range("M20").Value = singlecntr
'Range("M21").Value = empspcntr
'Range("M22").Value = empchcntr
'Range("M23").Value = famcntr
End Sub

austenr
05-11-2005, 02:24 PM
Zack...I am not sure what you mean concerning your last post in this thread.

Killian
05-11-2005, 03:02 PM
You need to pass the ws variable from the WorksheetLoop routine to DetermineCoverageTypes as indicated otherwise each time DetermineCoverageTypes is called, it is just acting on the active sheet.
Then, in DetermineCoverageTypes, add 'ws.' before each reference to the worksheet ranges you wish to work with as Zack says. e.g.


For s = 2 To 1081
Tempss = Range("G" & s - 1).Value

will change to


For s = 2 To 1081
Tempss = ws.Range("G" & s - 1).Value

and so on

austenr
05-11-2005, 03:39 PM
Thanks for the reply. I got it to loop. The main thing I am having trouble with is totals on each page. Where does that code go? Have tried it several places and none work. Thanks for your help and zack too.

austenr
05-12-2005, 09:53 AM
Can someone take a look and give me a clue as to where I can save the totals for each page so at the end I can add a worksheet and present them there. Thanks



Option Compare Text

Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
Sheets(I).Select
DetermineCoverageTypes
Next I
End Sub
Sub DetermineCoverageTypes()
'Checks to see if the value in column G is = previous row
'If so process next row, else, determine coverage types
Dim s, Tempss, TempMem, TempFam, singlecntr, empspcntr, famcntr, _
empchcntr As Integer
' Initialize counters
singlecntr = 0
empspcntr = 0
famcntr = 0
empchcntr = 0
Row = 2
For s = 2 To 1081
Tempss = Range("G" & s - 1).Value
TempMem = Range("I" & s - 1).Value
'Checks to see if the EE social on this line is <> to the one on the previous line
With Range("G" & s)
If .Value <> Tempss Then
TempFam = 0
TempMem = ""
End If
member = .Offset(, 2)
If member <> TempMem Then
Select Case member
Case Is = "Self"
TempFam = TempFam + 1
Case Is = "Spouse"
TempFam = TempFam + 2
Case Is = "Child"
TempFam = TempFam + 4
End Select
End If
If .Offset(1, 0) <> .Offset(0, 0) Then
Select Case TempFam
Case Is = 1
coverage = "Only"
singlecntr = singlecntr + 1
Case Is = 3
coverage = "Spouse"
empspcntr = empspcntr + 1
Case Is = 5
coverage = "Child"
empchcntr = empchcntr + 1
Case Is = 7
coverage = "Family"
famcntr = famcntr + 1
End Select
.Offset(0, -3).Formula = "Self " & coverage
End If
End With
Next s
End Sub

Bob Phillips
05-12-2005, 10:43 AM
Can someone take a look and give me a clue as to where I can save the totals for each page so at the end I can add a worksheet and present them there.

Why not create the summary spreadsheet at the start, and add to it as you go along?

austenr
05-12-2005, 11:49 AM
Using the code above could you show me where it would go? Thanks Just trying to learn.

austenr
05-12-2005, 11:57 AM
The problem becomes when you pass the four seperate sheets keeping the totals seperate.

Bob Phillips
05-12-2005, 12:03 PM
Using the code above could you show me where it would go?

Okay, I should be able to do that, but I need some help.

I can't figure out what the purpose of the Sub DetermineCoverageTypes is, so can you explain its objectives and methodology to me? From the text, it would seem you want to process each sheet, and although you iterate through them, I cannot see where in that procedure you refrence each sheet, it all seems to work on the activesheet. And what totals are you wanting to calculate?

austenr
05-12-2005, 01:51 PM
OK. If you look at the code the Determine Coverage loops through each sheet and determines coverage (It is driven from the Sub above it). At the time the message is written in this code:


If .Offset(1, 0) <> .Offset(0, 0) Then
Select Case TempFam
Case Is = 1
coverage = "Only"
singlecntr = singlecntr + 1
Case Is = 3
coverage = "Spouse"
empspcntr = empspcntr + 1
Case Is = 5
coverage = "Child"
empchcntr = empchcntr + 1
Case Is = 7
coverage = "Family"
famcntr = famcntr + 1
End Select
.Offset(0, -3).Formula = "Self " & coverage
End If

Is where I add to the coverage type counters, family, single, etc. I want to take those totals at the end of processing each sheet and store them or write them to a total sheet, zero out the counters and process the next sheet, etc. HTH

Bob Phillips
05-12-2005, 03:01 PM
If you look at the code the Determine Coverage loops through each sheet and determines coverage (It is driven from the Sub above it).

Here is my first shot at it. I have tried to highlight the changes


Option Compare Text

Sub WorksheetLoop()
Dim WS_Count As Long
Dim I As Long
'>>>>>> new code
Dim oWs As Worksheet
On Error Resume Next
Set oWs = Worksheets("Summary")
If oWs Is Nothing Then
Set oWs = Worksheets.Add(Before:=Worksheets(1))
oWs.Name = "Summary"
End If
On Error GoTo 0
With oWs
.Cells.ClearContents
.Range("A1").Value = "Sheet name"
.Range("B1").Value = "Only"
.Range("C1").Value = "Spouse"
.Range("D1").Value = "Child"
.Range("E1").Value = "Family"
.Rows(1).Font.Bold = True
End With
'>>>>>> end of new code
WS_Count = ActiveWorkbook.Worksheets.Count
'>>>>>> next line changed from 1 to 2 to avoid our summary sheet
For I = 2 To WS_Count
'>>>>>> line Sheets(I).Select deleted, not necessary
'>>>>>> next line changed to pass current sheet to proc
DetermineCoverageTypes Worksheets(I), I, oWs
Next I
oWs.Columns("A:E").AutoFit
End Sub

Sub DetermineCoverageTypes(sh As Worksheet, idx As Long, summary As Worksheet)
'Checks to see if the value in column G is = previous row
'If so process next row, else, determine coverage types
Dim s, Tempss, TempMem, TempFam, singlecntr, empspcntr, famcntr, _
empchcntr As Integer
' Initialize counters
singlecntr = 0
empspcntr = 0
famcntr = 0
empchcntr = 0
'>>>>>> new code to process sh and dot all sheet objects
With sh
'>>>>>> end of new code
Row = 2
For s = 2 To 1081
Tempss = .Range("G" & s - 1).Value
TempMem = .Range("I" & s - 1).Value
'Checks to see if the EE social on this line is <> to the one on the previous line
With .Range("G" & s)
If .Value <> Tempss Then
TempFam = 0
TempMem = ""
End If
member = .Offset(, 2)
If member <> TempMem Then
Select Case member
Case Is = "Self"
TempFam = TempFam + 1
Case Is = "Spouse"
TempFam = TempFam + 2
Case Is = "Child"
TempFam = TempFam + 4
End Select
End If
If .Offset(1, 0) <> .Offset(0, 0) Then
Select Case TempFam
Case Is = 1
coverage = "Only"
singlecntr = singlecntr + 1
Case Is = 3
coverage = "Spouse"
empspcntr = empspcntr + 1
Case Is = 5
coverage = "Child"
empchcntr = empchcntr + 1
Case Is = 7
coverage = "Family"
famcntr = famcntr + 1
End Select
.Offset(0, -3).Formula = "Self " & coverage
End If
End With
Next s
'>>>>>> new code to process sh and dot all sheet objects
End With
With summary
'now write totals to summary sheet
.Cells(idx, "A").Value = sh.Name
.Cells(idx, "B").Value = singlecntr
.Cells(idx, "C").Value = empspcntr
.Cells(idx, "D").Value = empchcntr
.Cells(idx, "E").Value = famcntr
End With
'>>>>>> end of new code
End Sub

austenr
05-12-2005, 03:50 PM
Great!! One shot is all you needed. Thanks a million!! Would have never thought of that...

Bob Phillips
05-12-2005, 04:12 PM
Great!! One shot is all you needed. Thanks a million!! Would have never thought of that...

I'm surprised, but pleased :). Hope the comments helped you in your learning.