How can I run VBA Worksheet_BeforeDoubleClick on a (new) daily extract.csv

Hi,
My situation is that I’ve trying for days now to find VBA code that will insert time stamp into a specified range of cells and if the user Double Clicks the cell again it will remove the time stamp. Each time a new daily exported.csv opens

The reason is that the users receive daily a newly created exported.csv file, so I need the VBA to be called/running from the users Personal.xlsb.

Now, I know that I could use the keyboard shorts cut, but believe it or not some of my users will never remember this method. So I need a method to do this using VBA, (the vba needs to be able to run from …\XLSTART\ personal.xlsb only if the new export.csv s worksheet name is named “ Whatever-Exports” .

After trawling the big “www”, I have found heaps of examples on how to insert the time stamp into a range of cells but they all use the Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) event .
Which will never be normally available to the new daily exported.csv.
So this is where I am having the difficulty as I don’t know how to call the Worksheet_BeforeDoubleClick when a new workbook is opened as it seems, even when the VBA is residing within the users “ personal.xlsb”
I finally found this sample:
http://stackoverflow.com/questions/1...ate-workbook-t

I am sure this'll work, but after reading a few times, and a few attempts, I just can’t get my head around the instructions to suit it my needs.

So my Question is, is this achievable? and is there a more simple way and if so how?

Any help in simple (laymans terms) would be great , thanks in advance

VBA Code below is what I am attempting to get to run from any new workbook/sheet with a specific name

Code:

---

Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim MyRange As Range
Dim IntersectRange As Range
Dim EndRow As Long
Dim TheWorksheetname As String


TheWorksheetname = ActiveSheet.Name

‘Application.ScreenUpdating = False

If TheWorksheetname = "ExportedWork_Sheet1" Then

EndRow = Range("D" & Rows.Count).End(xlUp).Row
Set MyRange = Range("G2:J" & EndRow)  'last row
Set IntersectRange = Intersect(Target, MyRange)
On Error GoTo SkipIt
If IntersectRange Is Nothing Then
  Exit Sub
Else
Target = Format(Now, "ttttt") ’still to find a way to format to lose the secs or  …=(left(A1,5) 
'Application.ScreenUpdating = True
End If
ActiveCell.Offset(, 1).Select  ‘ move curser away from cell
SkipIt:
Exit Sub
Else
'MsgBox "File does not exist"
exit sub
End If
End Sub

---

In their Personal Excel book, in the ThisWorkbook Code page, declare an App Object

Code:

---

Option Explicit

Public WithEvents ThisApp As Application
 
Private Sub Workbook_Open()
    Set ThisApp = Me.Application
End Sub

'This one is tested as written
Private Sub ThisApp_WorkbookOpen(ByVal Wb As Workbook)
  'Do stuff
End Sub

'This one is not
Sub ThisApp_SheetBeforeDoubleClick(ByVal Sht As Object, ByVal Target As Range, Cancel As Boolean)

If Sht.Parent Is ThisWorkbook Then Exit Sub

'If all Workbook will have the same Root
'If not Sht.Parent.Path = ??? Then exit Sub

'If all have a similar name part
'If not InStr(Sht.Parent.Name, NamePart), then Exit Sub

'Do Stuff

End Sub

---

SamT many thanks for responding.

Ok, I have added the following VBA to the users Personal.xlsb under : - VBAPRoject(PERSONAL.XLSB) > ThisWorkbook

Then saved and debug > compile , which all went fine.

Then I closed down all the excel applications > then re-opened excel with a new blank worksheet

and attempted to double clicked within the range G2:G1000 and nothing happens

Code:

---

Sub ThisApp_SheetBeforeDoubleClick(ByVal Sht As Object, ByVal Target As Range, Cancel As Boolean)
   
    If Sht.Parent Is ThisWorkbook Then Exit Sub
   
    'If all Workbook will have the same Root
    'If not Sht.Parent.Path = ??? Then exit Sub
    'If all have a similar name part
    'If not InStr(Sht.Parent.Name, NamePart), then Exit Sub
    'Do Stuff
Dim MyRange As Range
Dim IntersectRange As Range
''''Dim EndRow As Long
'
'
'''''Application.ScreenUpdating = False
'
'''''EndRow = Range("D" & Rows.Count).End(xlUp).Row
'''''Set MyRange = Range("G2:J" & EndRow)  'last row
Set MyRange = Range("G2:G1000")  'last row
Set IntersectRange = Intersect(Target, MyRange)
On Error GoTo SkipIt
If IntersectRange Is Nothing Then
    Exit Sub
Else
'
'
'
Target = Format(Now, "ttttt")
MsgBox " still need to format cells with ...custom macro hh:mm"
'
'''''Application.ScreenUpdating = True
End If
ActiveCell.Offset(, 1).Select
'
'
SkipIt:
Exit Sub
'
   
End Sub

---

Does anyone have any other suggestions on how to resolve my issue

SamT's suggestion works here.
In order to debug, paste the following (very similar) code into the ThisWorkbook code-module of PERSONAL.XLSB to replace any existing code:

Code:

---

Public WithEvents ThisApp As Application
 
Private Sub Workbook_Open()
    Set ThisApp = Me.Application
End Sub
 
 'This one is tested as written
Private Sub ThisApp_WorkbookOpen(ByVal Wb As Workbook)
    'Do stuff
    MsgBox "ThisAppWorkbookOpen"
End Sub
 

Sub ThisApp_SheetBeforeDoubleClick(ByVal Sht As Object, ByVal Target As Range, Cancel As Boolean)
'Stop
    If Sht.Parent Is ThisWorkbook Then Exit Sub
   
    'If all Workbook will have the same Root
    'If not Sht.Parent.Path = ??? Then exit Sub
    'If all have a similar name part
    'If not InStr(Sht.Parent.Name, NamePart), then Exit Sub
    'Do Stuff
    Dim MyRange As Range
    Dim IntersectRange As Range
    ''''Dim EndRow As Long
    '
    '
    '''''Application.ScreenUpdating = False
    '
    '''''EndRow = Range("D" & Rows.Count).End(xlUp).Row
    '''''Set MyRange = Range("G2:J" & EndRow)  'last row
    Set MyRange = Range("G2:G1000") 'last row
    'Stop
    Set IntersectRange = Intersect(Target, MyRange)
    On Error GoTo SkipIt
    If IntersectRange Is Nothing Then
        Exit Sub
    Else
        '
        '
        '
        Target = Format(Now, "ttttt")
        MsgBox " still need to format cells with ...custom macro hh:mm"
        '
        '''''Application.ScreenUpdating = True
    End If
    ActiveCell.Offset(, 1).Select
    '
    '
SkipIt:
    Exit Sub
    '
   
End Sub

---

Close Excel and click Yes to saving changes to Personal.xlsb.
The important part from a debugging point of view is the
MsgBox "ThisAppWorkbookOpen"
line; this should cause a message to appear when every/any workbook is opened, even when starting Excel.
If this doesn't happen report back here.

If it does happen - great.
So next, see two commented-out lines in the code:
'Stop
?
Enable them by taking out the apostrophe in both cases.
Now when you double-click a sheet, the vbe should appear with the yellow highlight on the Stop instruction. If it doesn't, you may, while adjusting the code, have come across a pop-up which asks 'This action will reset your project, proceed anyway?', where you have to click OK if you want your changes to take effect. This will do what it says on the tin. If that's happened, you just need manually to run the existing

Code:

---

Private Sub Workbook_Open()
    Set ThisApp = Me.Application
End Sub

---

to get it going again.

That's enough to be getting on with - come back and tell us how you get on.

Well it sure works, not that I totally understand why, only snag is I and users double click on any workbook sheet and it put the time in, which is not so good, I know the name of the workbook.sheet.csv that I need this to work on and would really like it to only work for that workbook_name. sheet1Name, as there heaps of other macros in their personal.xlsb, so obviously this user can't use those other ones ,like all the other users at the moment (with 1X keyboard shortcut for all of the different exported.csvs presently all users just need to only remember the keyboard short cut key to auto run the appropriate macro for each *.csv based on the name of the exported file they have open. such as :

Code:

---

Sub DiscoverWhatRptRan()
'
' Keyboard Shortcut: Ctrl+g
'
'To Automatically choose the correct
'VBA based on sheet name
'using option/Case Statement

Dim TheWorksheetname As String

TheWorksheetname = ActiveSheet.Name


    If TheWorksheetname = "Exported Account1234 - " Then
        'do something
        '////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
      Call macro1
   
    Else
MsgBox "File does not exist"

End If
If TheWorksheetname = "Exported Account4321 - " Then
     
      Call macro2
   
    Else etc etc!

---

can this code you gave be amended to only work on a named worksheet like the other macros

Quote:

---

Originally Posted by gint32

Well it sure works

---

Good, that puts this to bed:

Quote:

---

Originally Posted by gint32

attempted to double clicked within the range G2:G1000 and nothing happens

---

Quote:

---

Originally Posted by gint32

only snag is I and users double click on any workbook sheet and it put the time in, which is not so good

---

Well, my last message was a debugging exercise; I did say:

Quote:

---

Originally Posted by p45cal

That's enough to be getting on with - come back and tell us how you get on.

---

Quote:

---

Originally Posted by gint32

I know the name of the workbook.sheet.csv that I need this to work on and would really like it to only work for that workbook_name. sheet1Name

---

and:

Quote:

---

Originally Posted by gint32

can this code you gave be amended to only work on a named worksheet like the other macros

---

Of course it can. If the name of the sheet is invariable, tell us what it is. If it isn't (and I suspect this is the more likely scenario) then tell us what parts of the sheet name do remain constant and which parts are variable and how they may vary. Also, while the sheet name may be enough, in order to make the code really only work when you want it to, we could probably treat the file name in the same way, so some accurate and comprehensive information from you on the file names and sheet names is required.

I may not respond today.

Hi, thanks for your response and also I did find your code worked and very useful, I am not sure why you suspect my sheet will be a different name each day, reading my last post the vba example clearly shows that all my macros remains a constant. Anyways, this workbook will be a constant named (Daily Fin_Exports) and the workbook name will always be named "Daily ExAccounts", hence as I explained earlier with the multiple if else/s.

Code:

---

If TheWorksheetname = "Exported Account1234 - " Then

---

otherwise none of my multiple macros would work with the users.

Many thanks in advance once again for taking the time to even look

Sub ThisApp_SheetBeforeDoubleClick(ByVal Sht As Object, ByVal Target As Range, Cancel As Boolean)

In re the above:

Sht is a RAM clone of the Sheet that was double clicked
Target is a RAM Clone of the cell that was double clicked
Cancel must be set to True to prevent Excel from perfoming any actions on the original cell on the original sheet that would normally take place.
Sht.Parent is the Workbook that contains the Sheet

Quote:

---

Anyways, this workbook will be a constant named (Daily Fin_Exports)
and the workbook name will always be named "Daily ExAccounts",

---

Here is a Hierarchical system for deciding which macro to run. It all starts from the App_DoubleClick Event Procedure.

'''''All DoubleClicks. Determine Workbook

Code:

---

Sub ThisApp_SheetBeforeDoubleClick(ByVal Sht As Object, ByVal Target As Range, Cancel As Boolean)
Dim WkBk As Workbook 
 
    If Sht.Parent Is ThisWorkbook Then Exit Sub 'Never run this sub against this Personal.xlsb

Set WkBk = Sht.Parent
    'An exclusive test for different workbooks. If Book is not in list, the Sub exits
  With WkBk
      If Instr(.Name, "Daily Fin_Exports") then Fin_Reports WkBk, Sht, Target, Cancel   
    If Instr(.Name, "SomeOtherName") Then Macro2 WkBk, Sht, Target, Cancel
End With
 
'Macros set Cancel ByRef to reflect back here
   
End Sub

---

'''Double Clicks in certain Workbook. Determine Sheet

Code:

---

Sub Fin_Reports(ByVal WkBk As Object, ByVal Sht As Object, ByVal Target As Range, ByRef Cancel As Boolean)

If Sht.Name = "XYZ" Then MacroXYZ WkBk, Sht, Target, Cancel
If sht.Name = "ABC" Then MacroABC Sht, Target, Cancel

End Sub

---

''''DoubleClicks in Certain Sheet in Certain Workbook. Determine Cell

Code:

---

Sub MacroXYZ(ByVal WkBk As Object, ByVal Sht As Object, ByVal Target As Range, ByRef Cancel As Boolean)

'Test for appropriate ranges
If Not Intersect(WkBk.Sht.Range("G2:G1000"), Target) Is Nothing Then
''If a macro is going to handle the D-Click event, then set Cancel
Cancel = True '<---------First time set

'To Call a macro in Personal
PersonalMacro1 WkBk, Sht, Target  'Do NOT pass "Cancel"

'To Call a Macro in the D-Clicked workbook
'Wkbk.WorkbookMacro1 WkBk, Sht, Target 'Do NOT pass "Cancel"
End If

If Not Intersect(WkBk.Sht.Range(Some other Range), Target) Is Nothing Then
''If a macro is going to handle the D-Click event, then set Cancel
Cancel = True '<---------First time set
'Do Stuff
End If

'Repeat as needed
End Sub

---

Basically, The App Event Sub determines which Workbook has the Sheet that has the Cell that was D-Clicked and calls a Specific Sub to determine which Sheet in the relevant Workbook has the Cell that was D-Clicked. Then A Range determining sub is called. These Range Determining Subs are the ones that finally Set Cancel to True and which call the various subs that do the actual work on the Cells.

Note that it is the App Event Sub that Sets the WkBk Variable Value. All the Sub Parameters are always passed all the way down and it is the individual Macros that determine which Parameters to use. But they still pass all the parameters on to the next sub.

This means that every macro declaration is the same, except for the name.
Sub Name(ByVal WkBk As Object, ByVal Sht As Object, ByVal Target As Range, ByRef Cancel As Boolean)
Note: You don't want to pass the Cancel after it's been Set.

This system makes it very easy to edit and modify the Project Code Flow as needed. You have a library of "working" Macros and the Hierarchical decision tree merely chooses which one(s) to run.
Note: None of the "working" Subs should be in the Personal ThisWorkbook Code Page

Quote:

---

E=SamT;353301]Sub ThisApp_SheetBeforeDoubleClick(ByVal Sht As Object, ByVal Target As Range, Cancel As Boolean)

---

In re the above:

Code:

---

... is a RAM clone of the Sheet that was double clicked...

---

Sorry, to ask, but I know what a clone is, but have no idea what a RAM Clone is, excuse my ignorance.

Code:

---

Note: None of the "working" Subs should be in the Personal ThisWorkbook Code Page

---

Yes, None of my subs reside in the Personal ThisWorkbook Code Page, only code that is at present is this below :
I do have a have a library of "working " Macros and I'd like to be able to merely add this one to it and let my sub below choose which one(s) to run.

Code:

---

Sub DiscoverWhatRptRan()
    '
    ' Keyboard Shortcut: Ctrl+g
    '
    'To Automatically choose the correct
    VBA based on sheet name

---

,

Thanks again, note : only the code below is in my personal>thisworkbook

Code:

---


Public WithEvents ThisApp As Application
 
Private Sub Workbook_Open()
    Set ThisApp = Me.Application
End Sub
 
 'This one is tested as written
Private Sub ThisApp_WorkbookOpen(ByVal Wb As Workbook)
    'Do stuff
    'MsgBox "ThisAppWorkbookOpen"
End Sub
 
 
Sub ThisApp_SheetBeforeDoubleClick(ByVal Sht As Object, ByVal Target As Range, Cancel As Boolean)
    'Stop
    If Sht.Parent Is ThisWorkbook Then Exit Sub
   
    'If all Workbook will have the same Root
    'If not Sht.Parent.Path = ??? Then exit Sub
    'If all have a similar name part
    'If not InStr(Sht.Parent.Name, NamePart), then Exit Sub
    'Do Stuff
    Dim MyRange As Range
    Dim IntersectRange As Range
    Dim EndRow As Long
    '
    '
    Application.ScreenUpdating = False
    '
    EndRow = Range("D" & Rows.Count).End(xlUp).Row
    MsgBox EndRow
    Set MyRange = Range("G2:J" & EndRow)  'last row
    'Set MyRange = Range("G2:G1000") 'last row
    'Stop
    Set IntersectRange = Intersect(Target, MyRange)
    On Error GoTo SkipIt
    If IntersectRange Is Nothing Then
        Exit Sub
    Else
        '
        '
        Target = Format(Now, "ttttt")
      ' MsgBox " still need to format cells with ...custom macro hh:mm"
        '
        Application.ScreenUpdating = True
    End If
    ActiveCell.Offset(, 1).Select
    '
    '
SkipIt:
    Exit Sub
    '
   
End Sub

---

Is this where it should stay, or was this just for testing purposes?

I'm sorry. I wasn't clear. The majority of my previous was a short example of the code for your Personal ThisWorkbook Page.

It's a coding paradigm where the Event Sub only makes a few top level decisions and as the Code Flow passes to lower level Subs, They make lower level decisions. Technically, only the Event sub must be in ThisWorkbook, but in this case I like to keep the entire tree in one Code Module.


At a much higher level of Programming, I might treat each decision the Event Sub makes to it's own Module. This has the advantages of smaller Standard Modules with more room to grow, and facilitates Porting the code to a stand-alone program.

If you feel like you might be maintaining this code, or that the code will be used, for many years, you, too, should probably do this.


I went to this much depth only because we still don't know the exact details of your situation and I wanted to cover some possibilities.

Many thanks, I tihnk I may have over explained my needs.

My question, situation and code was/is not meant to be complex.

Put real simply, All I wanted was for my user/s to be able to DBL_click a range on a specific (Constant) named (workbook > sheet1), and insert the current time within that range specified, and a way of checking if its not the target workbook>sheet than exit & do nothing.

but since many users can run the same report, I guessed each user would need the VBA code would need to reside in their personal.xlsb
(Thats it!)


But, In all the macros I written though, I'd never really came across a situation on how to call an event macro for example calling a sub before doubleclick from the personal.xlsb to run on a new daily Exported CSV.

I didn't think it would be this complex to do as it seems rather alot

Quote:

---

Put real simply, All I wanted was for my user/s to be able to DBL_click a range on a specific (Constant) named (workbook > sheet1), and insert the current time within that range specified, and a way of checking if its not the target workbook>sheet than exit & do nothing.

---

Since you won't tell us anything about the Range Specified, this assumes that the Cell that is doubleclicked is that range.

Code:

---

Option Explicit
 
Public WithEvents ThisApp As Application
 
Private Sub Workbook_Open()
    Set ThisApp = Me.Application
End Sub

Sub ThisApp_SheetBeforeDoubleClick(ByVal Sht As Object, ByVal Target As Range, Cancel As Boolean)
Const WkBkNamePart as String = '??? Edit to suit
Const ShtNamePart As String  =  '??? Edit to suit

'Decision Tree
If Instr(Sht.Parent.Name, WkBkNamePart) = 0 Or _
If Instr(Sht.Name, ShtNamePart) = 0 Or _
If Intersect(Target, Range(Range("G2"), Cells(Rows.Count, "G").End(xlUp)) Is Nothing Then Exit Sub

Cancel = True
Target = Format(Now, "mm, dd, yyyy")
End Sub

---

That is all the code to accomplish what you said in your post #12. Yes. It all goes in the Personal file, ThisWorkbook Page.

Hi, Thanks for you patience and also my Apologies, but my range was always in post #1
here it is again, I'll now give the last post a shot...thanks once again.

Code:

---

Set MyRange = Range("G2:J" & EndRow) 'last row

---

To lose the seconds in the TimeStamp, the Format string is "mm, dd, yyyy hh:mm"

I'm assuming you know how to edit that code for use your range for the TimeStamp.







And please, in the future, when someone asks fore more information (that you already provided,) don't say, "I already posted that," or something to that affect. Just tell us again, so we don't have to carefully read every post you made. :banghead:

Quote:

---

Originally Posted by SamT

To lose the seconds in the TimeStamp, the Format string is "mm, dd, yyyy hh:mm"
I'm assuming you know how to edit that code for use your range for the TimeStamp. And please, in the future, when someone asks fore more information (that you already provided,) don't say, "I already posted that," or something to that affect. Just tell us again, so we don't have to carefully read every post you made. :banghead:

---

Apologies, once again, I was only referring to your coment "Since you won't tell us anything about the Range Specified", it wasn't meant to be condescending in anyway or form.

I had to amend your posted code (ever so slightly) by removing the If's from the or's and adding a missing ")" , but it finally does what I was originally asking for apart from one thing which is losing the secs in the time stamp (not date stamp), but that's not the worst thing in the world to deal with.

Thanks to god and this forum(from everyone who supplied some input), I now super happy and more importantly have a complete understand how your code works.
...

Code:

---

Sub ThisApp_SheetBeforeDoubleClick(ByVal Sht As Object, ByVal Target As Range, Cancel As Boolean)
    'stop
    Const WkBkNamePart As String = "Daily Fin_Exports.xlsx"      '??? Edited to suit
    Const ShtNamePart As String = "XYZ"                    '??? Edited to suit
   
    'Decision Tree
    If InStr(Sht.Parent.Name, WkBkNamePart) = 0 Or _
    InStr(Sht.Name, ShtNamePart) = 0 Or _
    Intersect(Target, Range(Range("G2"), Cells(Rows.Count, "G").End(xlUp))) Is Nothing Then
    Exit Sub
    End If
    Cancel = True
   
            If Target = "" Then

                    Target = Format(Time, "hh:mm")
                  '
                  'Target = Format(Now, "ttttt")
                Else
                    Target = ""
                End If
               
  ' Target = Format(Now, "mm, dd, yyyy")

End Sub

---

Quote:

---

I had to amend your posted code (ever so slightly) by removing the If's from the or's and adding a missing ")"

---

Sorry about that. I didn't use the VB Editor to write that code, so it wasn't checking my work for me.



Just FYI:

Now = Date + Time
Now Number Type = Double. Ex: 42710.403484375
Date Number Type ~ Long. Ex: 42710
Time Number Type ~ Decimal. Ex: 0.403484375

Excel Stores all Dates and Times as Doubles.
Now = 42710.403484375 = 12/06/2016 09:42
Date = 42710 = 12/06/2016
Time = 0.403484375 = 09:42

To test, enter some dates and times in column A. Format Cells in Column B as Number with 15 digits. Column B Formulas = "=A1" etc



Format (Time, "hh:mm") = Format (Now, "hh:mm")
Format (Date, "mm, dd, yyyy") = Format (Now, "mm, dd, yyyy")

Format Time or Date (..., "mm, dd, yyyy hh:mm") = Error

Quote:

---

Originally Posted by SamT

Sorry about that. I didn't use the VB Editor to write that code, so it wasn't checking my work for me.



Just FYI:

Now = Date + Time
Now Number Type = Double. Ex: 42710.403484375
Date Number Type ~ Long. Ex: 42710
Time Number Type ~ Decimal. Ex: 0.403484375

Excel Stores all Dates and Times as Doubles.
Now = 42710.403484375 = 12/06/2016 09:42
Date = 42710 = 12/06/2016
Time = 0.403484375 = 09:42

To test, enter some dates and times in column A. Format Cells in Column B as Number with 15 digits. Column B Formulas = "=A1" etc



Format (Time, "hh:mm") = Format (Now, "hh:mm")
Format (Date, "mm, dd, yyyy") = Format (Now, "mm, dd, yyyy")

Format Time or Date (..., "mm, dd, yyyy hh:mm") = Error

---

more knowledge to add to the data banks ,thanks for the info