VBA Double Click Macro dependent upon a range (column)
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:
Code:
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
