I have successfully recreated a macro that this forum helped me with. I have a table with two columns:
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"
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
Set wb1 = Workbooks.Add
'~~> Change the file Name Here
Application.CutCopyMode = False
Application.ScreenUpdating = True