Mega Quick VBA Amendement

[MrMaker]

Afternoon all,

Really quick one.

I have some code (below) that generally works fine (to filter sheets), however, I don't want it to run on a new sheet called 'Summary' and I am getting a debug error.
Can someone add a line to basically say 'ignore Summary sheet' and run only on "Sheet 1". "Sheet 2" and "Sheet 3"

Thank you in advance

Private Sub Workbook_Open()

Dim Sht As Worksheet, R As Range

Application.ScreenUpdating = False

For Each Sht In Me.Worksheets

    If Sht.Name <> "Data Selection" Then

        Set R = Sht.Range("A1").CurrentRegion

        R.AutoFilter field:=1, Criteria1:="<>" & Sheets("Data Selection").Range("A1")

        On Error Resume Next

        Set R = R.Offset(1, 0).SpecialCells(xlCellTypeVisible)

        On Error GoTo 0

        Sht.AutoFilterMode = False

        If Not R Is Nothing Then R.EntireRow.Delete

    End If

    Sht.Rows.RowHeight = 25

Next Sht

With Sheets("Data Selection")

    .Range("A1").Value = .Range("A1").Value

    .Rows.RowHeight = 25

    .Visible = xlHidden

End With

Application.ScreenUpdating = True

End Sub

 

[rlv01]

Can someone add a line to basically say 'ignore Summary sheet' and run only on "Sheet 1". "Sheet 2" and "Sheet 3"

There are a couple of ways to approach this. #1 is to specify the sheets you want to allow the code to run on. Example:

        'This example will only run the code on sheets you specifically name
        Select Case Sht.Name
        Case "Sheet 1", "Sheet 2", "Sheet 3"
            Set R = Sht.Range("A1").CurrentRegion

            R.AutoFilter field:=1, Criteria1:="<>" & Sheets("Data Selection").Range("A1")

            On Error Resume Next

            Set R = R.Offset(1, 0).SpecialCells(xlCellTypeVisible)

            On Error GoTo 0

            Sht.AutoFilterMode = False

            If Not R Is Nothing Then R.EntireRow.Delete

        End Select

A 2nd way is to create an exclude list of sheets you do NOT want the code to run on. Example:

        'This example excludes a list of sheets that you specify and run on the rest.
        Select Case Sht.Name
        Case "Data Selection", "Summary sheet", "FAQs"       'list of sheets to ignore
        Case Else
            Set R = Sht.Range("A1").CurrentRegion

            R.AutoFilter field:=1, Criteria1:="<>" & Sheets("Data Selection").Range("A1")

            On Error Resume Next

            Set R = R.Offset(1, 0).SpecialCells(xlCellTypeVisible)

            On Error GoTo 0

            Sht.AutoFilterMode = False

            If Not R Is Nothing Then R.EntireRow.Delete

        End Select

 

[Fluff]

This should cater for the extra rows beyond the current region

Private Sub Workbook_Open()
   Dim Ws As Worksheet
   Dim Crit As String
   
   Application.ScreenUpdating = False
   Crit = Sheets("Data Selection").Range("A1").Value
   For Each Ws In Worksheets
      Select Case Ws.Name
         Case "Sheet1", "Sheet2", "Sheet3"
            Ws.UsedRange.AutoFilter 1, "<>" & Crit
            Ws.AutoFilter.Range.Offset(1).EntireRow.Delete
            Ws.AutoFilterMode = False
            Ws.Rows.RowHeight = 25
      End Select
   Next Ws
   With Sheets("Data Selection")
      .Range("A1").Value = Crit
      .Rows.RowHeight = 25
      .Visible = xlHidden
   End With
End Sub

 

[MrMaker]

Thank you both for your suggestions.

I've just got home so will give them both a whirl first thing tomorrow.

Really appreciate your time, love this place!!

 

[Fluff]

Glad we could help, let us know how it works out

 

[MrMaker]

Thanks Fluff, the code is brilliant and does exactly what I need!

It has, however, thrown up another snag.

When the code runs and filters the data accordingly it removes part of the array statement on the 'Summary' tab (highlighted in red).

The formula starts like this:
{=SUM(--(FREQUENCY(IF((Driver!$A$2:$A$1997=$B$2)*(Driver!$J$2:$J$1997<'Data Selection'!$A$3),MATCH(Driver!$D$2:$D$1997,Driver!$D$2:$D$1997,0)),ROW(Driver!$D$2:$D$1997)-ROW(Driver!$D$2)+1)>0))}

And ends like this:
{=SUM(--(FREQUENCY(IF((Driver!$A$2:$A$556=$B$2)*(Driver!$J$2:$J$556<'Data Selection'!$A$3),MATCH(Driver!$D$2:$D$556,Driver!$D$2:$D$556,0)),ROW(Driver!$D$2:$D$556)-ROW(Driver!#REF!)+1)>0))}

Any help would be greatly appreciated...........

MM

 

[Fluff]

Formulae are not my strong point, so you would be better off starting a new thread

 

[MrMaker]

No worries, I've found a solution using OFFSET, so all is now good!

Thank you very much!

I'll be back again soon no doubt ?

 

[Fluff]

Glad you sorted it & thanks for the feedback