Application.Intersect Over Multiple Sheets

AndyPandy27

Board Regular
Joined
Jul 17, 2012
Messages
142
Hi Guys,

I've been working on this for a while now, and having done some research, thought I found the correct answer; but it is not working for me. I am hoping a genius here might be able to help.

I have a small macro which allows the user of my file to see what the component parts of a "Group" are. The "Groups" are available (via Data Validation lists) in the Range C16:C1001 in three, separate, identical looking sheets ("Pricing Deal - Scenario 1", "Pricing Deal - Scenario 2" and "Pricing Deal - Scenario 3").

The component parts are all contained in a separate Table in a separate sheet called "Product Group Breakdown".

The macro takes the value ActiveCell, and then filters the Table (in the "Product Group Breakdown" sheet), using that value, to show the component parts.

Crude example would be the user has selected the Group called "Colours"; they then run the macro. The Table in "Product Group Breakdown" is filtered on the Group "Colours", and shows the components as: Red, Green, Yellow. The user now knows what is contained in the Group "Colours".

What I am trying to do, is ensure that the user has run the macro from a Cell within the correct Range (per the above), and pop-up with a message if they are in the wrong range. I have come up with the following (apologies for the inelegect code, I'm very new to VBA). However, despite this seeming to be the solution from my searching, this is throwing up a "Method 'Intersect' of object '_Application' failed" error.

Code:
Sub ShowBreakdown()

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim a, b, c As Range
    Set a = Worksheets("Pricing Deal - Scenario 1").Range("C16:C1001")
    Set b = Worksheets("Pricing Deal - Scenario 2").Range("C16:C1001")
    Set c = Worksheets("Pricing Deal - Scenario 3").Range("C16:C1001")


    If Application.Intersect(ActiveCell, a) Is Nothing Then
        If Application.Intersect(ActiveCell, b) Is Nothing Then
            If Application.Intersect(ActiveCell, c) Is Nothing Then
                MsgBox "Invalid selection - no breakdown available.  Please select a Group Name.", vbOKOnly + vbCritical, "Error - Invalid Selection"
                Application.EnableEvents = True
                Application.ScreenUpdating = True
                Exit Sub
            End If
        End If
    End If
    
    Worksheets("Product Group Breakdown").Range("B4").Value = "This is the breakdown for:  " & ActiveCell.Value
    
    Worksheets("Product Group Breakdown").ListObjects("GroupsBreakdown").Range.AutoFilter Field:=3, Criteria1:=ActiveCell.Value
    
    Worksheets("Product Group Breakdown").Visible = xlSheetVisible
    Worksheets("Product Group Breakdown").Activate
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

If anyone can help, it would be greatly appreciated.

Andy
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Hi All,

I figured it out! You can't check the ActiveCell against three, separate Worksheets...

So, I came up with the following instead, to check if the relevant conditions were TRUE or FALSE via a Variable called "Check".

If anyone can make this better, that would be great!

Thanks,

Andy

Code:
Sub ShowBreakdown()


    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim a, b, c As Range
    Dim Check As Boolean
    Set a = Worksheets("Pricing Deal - Scenario 1").Range("C16:C1001")
    Set b = Worksheets("Pricing Deal - Scenario 2").Range("C16:C1001")
    Set c = Worksheets("Pricing Deal - Scenario 3").Range("C16:C1001")
    Check = True
    
    Select Case ActiveSheet.Name
        Case "Pricing Deal - Scenario 1"
            If Application.Intersect(ActiveCell, a) Is Nothing Then
                Check = False
            End If
        
        Case "Pricing Deal - Scenario 2"
            If Application.Intersect(ActiveCell, b) Is Nothing Then
                Check = False
            End If
            
        Case "Pricing Deal - Scenario 3"
            If Application.Intersect(ActiveCell, c) Is Nothing Then
                Check = False
            End If
        
        Case Else
            Check = False
    
    End Select


If Check = False Then
    MsgBox "Invalid selection - no breakdown available.  Please select a Group Name.", vbOKOnly + vbCritical, "Error - Invalid Selection"
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
End If
    
    Worksheets("Product Group Breakdown").Range("B4").Value = "This is the breakdown for:  " & ActiveCell.Value
    
    Worksheets("Product Group Breakdown").ListObjects("GroupsBreakdown").Range.AutoFilter Field:=3, Criteria1:=ActiveCell.Value
    
    Worksheets("Product Group Breakdown").Visible = xlSheetVisible
    Worksheets("Product Group Breakdown").Activate
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True


End Sub
 
Upvote 0
You could do something like this:
Code:
Sub ShowBreakdown()
    Dim Check                 As Boolean

    Check = True

    If Application.Intersect(ActiveCell, ActiveSheet.Range("C16:C1001")) Is Nothing Then
        Check = False
    End If

    If Check = False Then
        MsgBox "Invalid selection - no breakdown available.  Please select a Group Name.", vbOKOnly + vbCritical, "Error - Invalid Selection"
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    With Worksheets("Product Group Breakdown")
        .Range("B4").Value = "This is the breakdown for:  " & ActiveCell.Value

        .ListObjects("GroupsBreakdown").Range.AutoFilter Field:=3, Criteria1:=ActiveCell.Value

        .Visible = xlSheetVisible
        .Activate
    End With

    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub
 
Upvote 0
Thanks Rory - great shout.

So simple, so effective. I wish these ideas didn't allude me so frequently.

Appreciate the help!

Andy
 
Upvote 0
Although...

Correct me if I'm wrong; but your code doesn't take into consideration the various other sheets in the workbook, on which the users could attempt to run the macro.

So, theoretically, the user could be on another sheet (e.g. "Home"), attempt to run the macro, and, provided they are within the relevant Range on that sheet - the macro would still fire (even they we wouldn't want it to, because we only want them to run it on one of the three mentioned sheets).

I appreciate I didn't go into details and explain that there were other sheets available, so my fault!

Thanks again.
 
Upvote 0
If there are other possible sheets involved, you could use:
Code:
Sub ShowBreakdown()
    Dim Check                 As Boolean

    Check = False
    
    Select Case LCase$(ActiveSheet.Name)
        Case "pricing deal - scenario 1", "pricing deal - scenario 2", "pricing deal - scenario 3"
            Check = (Not Application.Intersect(ActiveCell, ActiveSheet.Range("C16:C1001")) Is Nothing)
    End Select

    If Check = False Then
        MsgBox "Invalid selection - no breakdown available.  Please select a Group Name.", vbOKOnly + vbCritical, "Error - Invalid Selection"
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    With Worksheets("Product Group Breakdown")
        .Range("B4").Value = "This is the breakdown for:  " & ActiveCell.Value

        .ListObjects("GroupsBreakdown").Range.AutoFilter Field:=3, Criteria1:=ActiveCell.Value

        .Visible = xlSheetVisible
        .Activate
    End With

    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub
 
Upvote 0

Forum statistics

Threads
1,215,575
Messages
6,125,631
Members
449,241
Latest member
NoniJ

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top