VBA Double Click Macro dependent upon a range (column)

[SIRCM]

Hi,
I have a 3 tab workbook and have utilised various forums to find the mechanics of what I need. In my file I have:
- Tab one has a table with a current year column and a prior year column.
- Tab two prior year data populating one column in the table in the first tab.
- Tab three is the same layout as prior year, but includes current year data only, again populating the table in the first tab.
The below VBA works when double clicking a number in the table and filtering on the second or third tab for the appropriate information.
My issue however is:
- I have had to hard code which tab to lookup to then apply the filters too
- Any number anywhere on the first tab activates the macro

Is there a way therefore to:
- limit where the double click macro is active
- Have the dimension 'wsdarttrans' change reference depending upon the column the numbers are in? (ie, if the double click in in column B, it goes to the 'Current' year tab, but if the double click is in column C, it goes to the prior year tab).

Hopefully an interesting question for someone to utilise their expertise. Excuse my own comments to remind me what each part does.

VBA code is:

Option Explicit
Const Cat1col = 1
Const Duecol = 2
Const Areacol = 5


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim iTargetrow As Integer, iTargetCol As Integer
Dim lngrow As Long, lngcol As Long
Dim WhichCat1 As String, Whichduedate As String, ReqCat1 As String, Reqduedate As String, ReqArea As String
Dim wsDartsum As Worksheet, wsdarttrans As Worksheet
Dim rngData As Range
Set wsDartsum = ActiveSheet
Set wsdarttrans = Worksheets("Data - Current Year")   'Require Manually amending to ''Data - Prior Year'' to filter on the next tab
iTargetrow = Target.Row
    iTargetCol = Target.Column
    WhichCat1 = wsDartsum.Range("A1").Offset(iTargetrow - 1, 0)
    Whichduedate = wsDartsum.Range("A1").Offset(0, iTargetCol - 1)
    ReqArea = wsDartsum.Range("A1").Offset(1, iTargetCol - 1)
If Target.Value = "" Or IsNumeric(Target.Value) = False Then
    Exit Sub
Else
    If WhichCat1 = 0 Then ReqCat1 = wsDartsum.Range("A1").Offset(iTargetrow - 1, 1)
    If WhichCat1 = 1 Then ReqCat1 = "<>"
    If Whichduedate = 0 Then Reqduedate = wsDartsum.Range("A1").Offset(3, iTargetCol - 1)
    If Whichduedate = 1 Then Reqduedate = "<>"
End If
'Set Range
wsdarttrans.Activate 'Moves to make tab 'Data - Current Year' the active sheet
lngrow = wsdarttrans.Cells.SpecialCells(xlCellTypeLastCell).Row 'Sets the last row of applicable data
Set rngData = wsdarttrans.Range("B1:K" & lngrow) 'Creates the range the filters will be applied to, here starting in columns B to K
'Apply filters based upon selection
With Selection
    .AutoFilter field:=Cat1col, Criteria1:=ReqCat1, Operator:=xlAnd 'Applies a filter to the first column of your range (note, not the first column of the tab).
    .AutoFilter field:=Duecol, Criteria1:=Reqduedate ' Applies a filter to the Second column of your range (note, not the first column of the tab).
    .AutoFilter field:=Areacol, Criteria1:=ReqArea 'Applies a filter to the fifth column of your range (note, not the first column of the tab).
End With
wsdarttrans.Range("B1").Select ' Returns to cell B1 as the active cell
End Sub

Many thanks in advance.

Chris

[Aflatoon]

Try this:

Option ExplicitConst Cat1col = 1
Const Duecol = 2
Const Areacol = 5


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Dim iTargetrow As Long, iTargetCol As Long
   Dim lngrow As Long, lngcol As Long
   Dim WhichCat1 As String, Whichduedate As String, ReqCat1 As String, Reqduedate As String, ReqArea As String
   Dim wsDartsum As Worksheet, wsdarttrans As Worksheet
   Dim rngData As Range
   ' test if double clicking in columns B:C
   If Not Intersect(Target, Range("B:C")) Is Nothing Then
      If Target.Value = "" Or IsNumeric(Target.Value) = False Then
          Exit Sub
      Else
         Set wsDartsum = Me
         If Target.Column = 2 Then
            Set wsdarttrans = Worksheets("Data - Current Year")
         Else
            Set wsdarttrans = Worksheets("Data - Prior Year")
         End If
         iTargetrow = Target.Row
         iTargetCol = Target.Column
         WhichCat1 = wsDartsum.Range("A1").Offset(iTargetrow - 1, 0)
         Whichduedate = wsDartsum.Range("A1").Offset(0, iTargetCol - 1)
         ReqArea = wsDartsum.Range("A1").Offset(1, iTargetCol - 1)
          If WhichCat1 = 0 Then ReqCat1 = wsDartsum.Range("A1").Offset(iTargetrow - 1, 1)
          If WhichCat1 = 1 Then ReqCat1 = "<>"
          If Whichduedate = 0 Then Reqduedate = wsDartsum.Range("A1").Offset(3, iTargetCol - 1)
          If Whichduedate = 1 Then Reqduedate = "<>"
      End If
      'Set Range
      wsdarttrans.Activate 'Moves to make tab 'Data - Current Year' the active sheet
      lngrow = wsdarttrans.Cells.SpecialCells(xlCellTypeLastCell).Row 'Sets the last row of applicable data
      Set rngData = wsdarttrans.Range("B1:K" & lngrow) 'Creates the range the filters will be applied to, here starting in columns B to K
      'Apply filters based upon selection
      With rngData
          .AutoFilter field:=Cat1col, Criteria1:=ReqCat1, Operator:=xlAnd 'Applies a filter to the first column of your range (note, not the first column of the tab).
          .AutoFilter field:=Duecol, Criteria1:=Reqduedate ' Applies a filter to the Second column of your range (note, not the first column of the tab).
          .AutoFilter field:=Areacol, Criteria1:=ReqArea 'Applies a filter to the fifth column of your range (note, not the first column of the tab).
      End With
      wsdarttrans.Range("B1").Select ' Returns to cell B1 as the active cell
   End If
End Sub

[SIRCM]

That's great and works just as I need.
Many thanks indeed for your help and prompt response.

Chris

[Paul_Hossler]

That's great and works just as I need.
Many thanks indeed for your help and prompt response.

Chris

Please mark it SOLVED using Thread Tools above your first post