Consulting

Results 1 to 4 of 4

Thread: VBA Double Click Macro dependent upon a range (column)

  1. #1
    VBAX Newbie
    Joined
    Sep 2024
    Posts
    2
    Location

    Question 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:

    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
    Last edited by Aussiebear; 09-05-2024 at 11:08 PM.

  2. #2
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,779
    Location
    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
    Be as you wish to seem

  3. #3
    VBAX Newbie
    Joined
    Sep 2024
    Posts
    2
    Location
    That's great and works just as I need.
    Many thanks indeed for your help and prompt response.

    Chris

  4. #4
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,787
    Location
    Quote Originally Posted by SIRCM View Post
    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •