Loopng through specific worksheets

[Confused]

I have a macro that loops through all worksheets based on criteria’s
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 can’t 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

 

[ryguy7272]

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---

 

[Joel]

you can use the val which will extract the number from the beginning of the
string tab name

for each sht in sheets
if isnumeric(val(sht.name)) then
'enter your code here
end if

next sht

 

[Confused]

I inserted the code you provided but when i run the macro, nothing is showing
up in my summary page. Can you tell me if I inserted the macro in the
correct place in the code?


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 Each wsh In Sheets
If IsNumeric(Val(wsh.Name)) Then

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

End If

Next wsh


endprog:
Worksheets("Summary").Activate
Application.StatusBar = "Processing Completed"
Application.ScreenUpdating = True


End Sub

 

[Joel]

The code is fine. Without seeing yoiur exact sheet names I can't determine
what is wrong. There is one case where my code may execute on the wrong
sheet which I dodn't think is the problem but should be fixed

from
If IsNumeric(Val(wsh.Name)) Then

to

If IsNumeric(Left(sht.Name, 1)) Then

Sub test()


mystr = "1 abc"
If IsNumeric(Left(mystr, 1)) Then
MsgBox ("String is numeric")
Else
MsgBox ("String is not numeric")

End If

For Each sht In Sheets
a = Val(sht.Name)
If IsNumeric(Left(sht.Name, 1)) Then
MsgBox (sht.Name & ": String is numeric")
Else
MsgBox (sht.Name & ": String is not numeric")

End If


Next sht


End Sub



Here is some test code that may help find the problem