Loopng through specific worksheets
This should give you some ideas:
For Each sh In Worksheets
If (sh.Name) < "Summary" Then
'Do something
Else
bWrite = False
End If
Next sh
For Each sh In ActiveWorkbook.Worksheets
If InStr(1, sh.Name, "Summary") Then
sh.Select False
Else
'Do Something sh.Delete (for example)
End If
Next sh
HTH,
Ryan---
--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.
"Confused" wrote:
I have a macro that loops through all worksheets based on criterias
specified. The problem is, I have a consolidated worksheet that summarizes
the individual worksheets as well, so when I run the macro, the I am getting
duplicate answers since the macro is looping through the consolidated
worksheet and the individual worksheets. I cant figure out how to fix the
macro so that it only loops through the individual worksheets€¦ each
individual worksheet is labeled as €ś1 name€ť.
Option Explicit
Sub Create_Summary()
Dim CritVal(3) As Variant
Dim ncrit As Integer
Dim CritIdx(3) As Integer
Dim lr As Long
Dim irow As Long
Dim orow As Long
Dim wsh As Variant
Dim hdgs As Variant
Dim matched As Boolean
Application.ScreenUpdating = False
hdgs = Array("Dealers", "Date", "Time", "Offering Face", "CUSIP",
"Security", "Shelf", "Vintage", "Class", "Avg Life", "Index", "Bid Spread",
"Bid Price", "Cover Spread", "Cover Price", "Comments")
'
' Check selection criteria
'
Worksheets("Summary").Activate
If Range("A2") = "" Then
MsgBox ("First selection is blank. Progam stopped")
GoTo endprog
Else
ncrit = 1
CritIdx(ncrit) = Application.Match(Range("A2"), hdgs, 0)
CritVal(ncrit) = Range("A3")
If Range("B2") < "" Then
ncrit = 2
CritIdx(ncrit) = Application.Match(Range("B2"), hdgs, 0)
CritVal(ncrit) = Range("B3")
If Range("C2") < "" Then
ncrit = 3
CritIdx(ncrit) = Application.Match(Range("C2"), hdgs, 0)
CritVal(ncrit) = Range("C3")
End If
End If
End If
'
' Write Headings
'
Range("A5").Resize(1, 16) = hdgs
Range("a6").Resize(1000, 16).Clear
orow = 5
' Loop through worksheets and match criteria .........
'
For wsh = 1 To Sheets.Count
If Sheets(wsh).Name = "Summary" Then GoTo nextwsh
Debug.Print Sheets(wsh).Name
Sheets(wsh).Activate
lr = Cells(Rows.Count, "A").End(xlUp).Row
For irow = 2 To lr
matched = False
Select Case ncrit
Case Is = 1
If Trim(Cells(irow, CritIdx(1))) = Trim(CritVal(1)) Then
matched = True
Case Is = 2
If Application.And(Trim(Cells(irow, CritIdx(1))) =
Trim(CritVal(1)), _
Trim(Cells(irow, CritIdx(2))) = Trim(CritVal(2))) _
Then matched = True
Case Is = 3
If Application.And(Trim(Cells(irow, CritIdx(1))) =
Trim(CritVal(1)), _
Trim(Cells(irow, CritIdx(2))) =
Trim(CritVal(2)), _
Trim(Cells(irow, CritIdx(3))) =
Trim(CritVal(3))) _
Then matched = True
End Select
If matched Then
orow = orow + 1
Range("a" & irow).Resize(1, 14).Copy Sheets("Summary").Range("A" &
orow)
End If
Next irow
nextwsh:
Next wsh
endprog:
Worksheets("Summary").Activate
Application.StatusBar = "Processing Completed"
Application.ScreenUpdating = True
End Sub
|