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