Solved

Double Click Event in Excel

Posted on 2011-03-15
3
388 Views
Last Modified: 2012-05-11

I have successfully recreated a macro that this forum helped me with.  I have a table with two columns:

Column1: Date
Column 2: Total Outstanding Checks Issued on that Date

I download/link data from several sources into one of the sheets.  And the Total Outsanding uses a sumproduct formula to get the total for that date.

I created a macro (code attached) that creates a new workbook with the items that make up that total.   I've assigned it to a button.  

Instead, I'd like to be able to double click on the cell containing the total and do the same action.  Can someone lead me in the right direction?
Private Sub CommandButton2_Click()
    Dim i As Long
    Dim lastRow As Long
    Dim rRow As Long, cCol As Long
    Dim TxnDate As Date
    Dim rng As Range
    Dim wb1 As Workbook
    
    '~~> Change the range to the relevant range here
    If Intersect(Selection, Range("u20:u29")) Is Nothing Then
        'the intersect function checks to see if the selection exists in the given range
        MsgBox "Please select the cell in the correct range"
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    'By setting ScreenUpdating to False at the Start of the macro, you will not only stop
    ' the constant screen flickering associated with recorded macro, but also greatly speed
    ' up the execution of the macro. The reason it speeds up code is because Excel no longer
    ' needs to repaint the screen whenever it encounters such commands as Select, Activate,
    ' LargeScroll, SmallScroll and many others.
           
    lastRow = Sheets("IssuedChecks").Range("A" & Rows.Count).End(xlUp).Row
    ' finds last row in IssuedChecks Worksheet
 MsgBox ("The last row is: " & lastRow)
    
   'This part tells the macro which row/date we are looking for
   rRow = Selection.Row
  MsgBox ("The current row is: " & rRow)
    
    TxnDate = Cells(rRow, 20).Value
    MsgBox ("We are looking for " & TxnDate)
        
    'Creating new table in memory?

    Set rng = Sheets("IssuedChecks").Range("A1:J1")
    
    
    For i = 2 To lastRow
        If Sheets("IssuedChecks").Range("c" & i).Value = TxnDate Then
           Set rng = Union(rng, Sheets("IssuedChecks").Range("A" & i & ":J" & i))
           'if the date matches, add this column to the open workbook
           
        End If
    Next i
    
    rng.Copy
     Set wb1 = Workbooks.Add
     wb1.Sheets(1).Activate
    ActiveSheet.Paste
    
    '~~> Change the file Name Here
    'wb1.SaveAs "\\adpsfs\Accounting\Bobby\MyFile.xls"
 
Call fitWidth

    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

Open in new window

0
Comment
Question by:BBlu
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
3 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 35144932
You could use the worksheet doubleclick handler:

You could also use the same code via a sub, personally I wouldn't recommend using a reference to the existing CommandButton2_Click rather move that code to a new sub in a normal code module and then in both cases reference that new sub

Chris
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    if not intersect(target, me.range("a1")) is nothing then
        newsubname
    end if

End Sub

Open in new window

0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 300 total points
ID: 35144945
Meant to say, replace "a1" with the cell containing your Total Outstanding and newsubname with the name you give your sub i.e.

1. Snippet in a normal code module.
2. Worksheet_BeforeDoubleClick in the worksheet code page as
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    if not intersect(target, me.range("a1")) is nothing then
        replaced_cb2_Click_event_handler_Sub
    end if

End Sub

3. Modified Private Sub CommandButton2_Click() as
Private Sub CommandButton2_Click()
    replaced_cb2_Click_event_handler_Sub
End Sub

Chris
Sub replaced_cb2_Click_event_handler_Sub()
    Dim i As Long
    Dim lastRow As Long
    Dim rRow As Long, cCol As Long
    Dim TxnDate As Date
    Dim rng As Range
    Dim wb1 As Workbook
    
    '~~> Change the range to the relevant range here
    If Intersect(Selection, Range("u20:u29")) Is Nothing Then
        'the intersect function checks to see if the selection exists in the given range
        MsgBox "Please select the cell in the correct range"
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    'By setting ScreenUpdating to False at the Start of the macro, you will not only stop
    ' the constant screen flickering associated with recorded macro, but also greatly speed
    ' up the execution of the macro. The reason it speeds up code is because Excel no longer
    ' needs to repaint the screen whenever it encounters such commands as Select, Activate,
    ' LargeScroll, SmallScroll and many others.
           
    lastRow = Sheets("IssuedChecks").Range("A" & Rows.Count).End(xlUp).Row
    ' finds last row in IssuedChecks Worksheet
 MsgBox ("The last row is: " & lastRow)
    
   'This part tells the macro which row/date we are looking for
   rRow = Selection.Row
  MsgBox ("The current row is: " & rRow)
    
    TxnDate = Cells(rRow, 20).Value
    MsgBox ("We are looking for " & TxnDate)
        
    'Creating new table in memory?

    Set rng = Sheets("IssuedChecks").Range("A1:J1")
    
    
    For i = 2 To lastRow
        If Sheets("IssuedChecks").Range("c" & i).Value = TxnDate Then
           Set rng = Union(rng, Sheets("IssuedChecks").Range("A" & i & ":J" & i))
           'if the date matches, add this column to the open workbook
           
        End If
    Next i
    
    rng.Copy
     Set wb1 = Workbooks.Add
     wb1.Sheets(1).Activate
    ActiveSheet.Paste
    
    '~~> Change the file Name Here
    'wb1.SaveAs "\\adpsfs\Accounting\Bobby\MyFile.xls"
 
Call fitWidth

    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

Open in new window

0
 

Author Closing Comment

by:BBlu
ID: 35151936
PERFECT, Chris.  And thanks for the additional notes and suggestions.
0

Featured Post

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

726 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question