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