Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to "update" a workbook instead of reopening it(using VBA macros)?

Tags:

excel

vba

I'm having problems with my below code:

Private Sub Worksheet_BeforeDoubleClick(ByVal...
Application.ScreenUpdating = False
Set wbks = Workbooks.Open("\\whatever\whatever.xlsx")           
wbks.Sheets("Control").Activate
ActiveSheet.Range("A3").Select 
Application.ScreenUpdating = True
...

As you can see, it opens a workbook everytime I double click a certain cell. The problem is: After the second time I double click I'm getting the annoying message:

"'Filename.xlsx' is already open. Reopening will cause any changes you made to be discarded..."

¿How can I turn this message off(since no changes were made), and if possible, make the target workbook gets "updated" after every double click instead of "re-open"?

like image 808
phalanx Avatar asked May 29 '13 23:05

phalanx


People also ask

How do I refresh a workbook in Excel VBA?

You can trigger a data refresh when your Excel file is first opened by pasting VBA code into the Workbook_Open event. Simply double-click the ThisWorkbook object in the VBA Project Pane to open the text editor (blank white sheet) within the Visual Basic Editor (keyboard shortcut Alt +F11).

How do I stop a workbook from opening a macro?

Start Excel Application > Go to File > Recent > Doing this will prevent the Workbook_Open event from firing and the Auto_Open macro from running.


1 Answers

You can use a function to check if it's already open:

Function WorkbookIsOpen(wb_name As String) As Boolean

On Error Resume Next
WorkbookIsOpen = CBool(Len(Workbooks(wb_name).Name) > 0)
End Function

Then in your procedure, call it like this:

Private Sub Worksheet_BeforeDoubleClick(ByVal...
Application.ScreenUpdating = False
If WorkbookIsOpen("whatever.xlsx") then
    Set wbks = Workbooks("whatever.xlsx")
Else
    Set wbks = Workbooks.Open("\\whatever\whatever.xlsx")
End If      
wbks.Sheets("Control").Activate
ActiveSheet.Range("A3").Select 
Application.ScreenUpdating = True

EDIT: If you really want to go crazy, you can use this function which checks if the file exists, and returns Nothing if it doesn't, else returns the Workbook, expanding slightly on the logic above:

Function GetWorkbook(WbFullName As String) As Excel.Workbook

'checks whether workbook exists
'if no, returns nothing
'if yes and already open, returns wb
'if yes and not open, opens and returns workbook
Dim WbName As String

WbName = Mid(WbFullName, InStrRev(WbFullName, Application.PathSeparator) + 1)
If Not WorkbookIsOpen(WbName) Then
    If FileExists(WbFullName) Then
        Set GetWorkbook = Workbooks.Open(Filename:=WbFullName, UpdateLinks:=False, ReadOnly:=True)
    Else
        Set GetWorkbook = Nothing
    End If
Else
    Set GetWorkbook = Workbooks(WbName)
End If
End Function

In addition to the WorkbookIsOpen function above, it uses this one:

Function FileExists(strFileName As String) As Boolean

If Dir(pathname:=strFileName, Attributes:=vbNormal) <> "" Then
    FileExists = True
End If
End Function

You could use this in your procedure like:

Private Sub Worksheet_BeforeDoubleClick(ByVal...
Application.ScreenUpdating = False
Set wbks = GetWorkbook("\\whatever\whatever.xlsx")
If wbks is Nothing Then
    MsgBox "That's funny, it was just here"
    'exit sub gracefully
End If
wbks.Sheets("Control").Activate
ActiveSheet.Range("A3").Select 
Application.ScreenUpdating = True
like image 89
Doug Glancy Avatar answered Sep 21 '22 06:09

Doug Glancy