How to use Linked Excel Workbooks in Shared Enviroment

[JLHSolutions]

Hello all,

I am pretty new to using Excel for this type of stuff as I came from using FileMaker, but as the company doesn't have that, I am learning how to do more with Excel.

I have a workbook (JobSheet) that we use for every job. You enter in some basic data on one worksheet (Job_Details) and then I have another worksheet (JOB_CHECKLIST) that converts all the entered data into the correct format. This part works.

I have now added in a link to another workbook that holds general values that we use all the time. That way, if something changes, I can add it to that workbook and then the JobSheet gets the new values when its opened. I thought I had this working, but it seems if 2 people open it up at the same time, the 2nd person gets an error message.

The errors are as follows:
External table is not in the expected format.
Then it asks for username, password, provider string, open mode.
Then it wants data link properties.


The linked workbook is shared, so I am not sure why it won't let the JobSheet workbook read it.

I am hoping that someone might be able to assist with this situation. Hopefully I have explained it well enough. If not, please let me know so I can provide more information.

Thanks!

 

[Jeffrey Mahoney]

This is my opinion and don't know if anybody else shares it. I HIGHLY recommend that you don't use a shared workbook. Too many problems. If two people are edited the same records or data at the same time, you will have major problems.

I suggest that you make the file read only and let one person edit that file at a time.

Jeff

 

[JLHSolutions]

The JobSheet file is a template so that when they open it, they are forced to save it as something when they close it. The other file is the shared file. That file is only used for pulling information from. No one else needs to access it, unless they need to make a change and I am not around.

In the JobSheet workbook, I created a connection to that other file and have it grabbing all the info from that sheet and dumping it into a table on a "hidden" sheet.

Maybe there is a better way that I can accomplish this.

 

[JLHSolutions]

Here's a little more info to help example what I am trying to accomplish.

The shared file contains a few tables. One table has a list of cities, zip codes, and counties. Another table has a list of employees, their names, phone numbers, etc. The idea was to use this table to pull information from. If we added in new information, the JobSheet template would refresh the linked tables that are inside with the new information that is stored in the shared file.

Maybe there is another way I can accomplish this task. I am open to suggestions. I would like to make it so that we don't get errors when opening up the file.

Thanks!

 

[Jeffrey Mahoney]

I suggest you make the linked file "Read Only".

I have created VBA code that can open a read only workbook, get the data from all the tables, and close it in about 5 seconds. I could share the code. You would, of course, need to customize it for all your tables. It may take some time. My opinion is that it is a way better way to share data. All of your satellite workbooks are kept up to date each time they open them.

Jeff

 

[JLHSolutions]

That would be great! Since I am new to VB code, is it pretty straight forward to modify?

 

[Jeffrey Mahoney]

OK, you asked for it!!

Focus on the GetMasterDB sub first. The other subs and functions are supporting. The GetMasterDB sub retrieves 3 tables from the workbook (WB). It opens the supporting WB in read only mode and copies the data to each table in the current WB. As I state in the code, I have a "SETUP" sheet where I store the path and filename of the supporting files I need get. For you, this is the most difficult part. You need to create named ranges in both the supporting WB tables and the current WB tables. I simply have a named range at the top left cell in each table.

This macro only copies the values, not the cell formatting. You will have to have the correct formatting already set in the current WB.

The EventsOff and EventsOn subs are designed to stop Excel from recalculating during the macro.

If you ever wanted to learn Excel VBA, here you go.

Jeff

Public iEvents As Integer

Sub EventsOff(Optional Force As Boolean)
  If iEvents < 1 Or Force = True Then
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
  End If
  iEvents = iEvents + 1
End Sub


Sub EventsOn(Optional Force As Boolean)
  If iEvents < 2 Or Force = True Then
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
  End If
  
  If Force = True Then
    iEvents = 0
  Else
    iEvents = iEvents - 1
  End If
End Sub





Sub GetMasterDB()
  Dim A As String
  Dim MelWB As Workbook
  Dim ListSht As Worksheet
  Dim ListRng As Range
  Dim MasterSht As Worksheet
  Dim MasterRng As Range
  Dim Cel As Range
  Dim LastSht As Worksheet
  Dim i As Range
  Dim Key1 As Range
  Dim Key2 As Range
  Dim Key3 As Range
  Dim R As Range
  Dim ThisWB As Workbook
  Dim WBName As String


  Set ThisWB = ThisWorkbook
  Set LastSht = ActiveSheet




  Call EventsOff




  Application.StatusBar = "Opening Master Database.  This may take up to 10 seconds"
  
  'I have a SETUP sheet where I store the names of support workbooks
  A = ThisWB.Sheets("Setup").Range("MasterDB").Value
  WBName = GetFileName(A)
  'If you already have the workbook open
  If IsWBOpen(WBName) = True Then
    Workbooks(WBName).Activate
    Set MelWB = ActiveWorkbook
    
  'Not open by you
  Else


    Application.DisplayAlerts = False
    On Error Resume Next
    'Opening a workbook in read only mode is faster
    Set MelWB = Workbooks.Open(A, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
    Application.DisplayAlerts = True
    If MelWB Is Nothing Then
      Call EventsOn
      Application.StatusBar = False
      MsgBox "The Ferndale Master Equipment List workbook cannot be found.  Contact the Portal Administrator."
      Exit Sub
    End If
  End If


  'There are several tables that I am updating from this workbook


  'P&ID  P&ID  P&ID  P&ID  P&ID  P&ID  P&ID  P&ID  P&ID  P&ID  P&ID  P&ID  P&ID
  Application.StatusBar = "Retrieving Master P&ID List.  This may take up to 5 seconds"
  Set ListSht = ThisWorkbook.Sheets("Master P&ID List")
  Set Cel = ListSht.Range("PIDEquip_hdr").Offset(1, 0)  'This is a named range on the sheet
  Set ListRng = Range(Cel, Cel.Offset(1000000, 3))


  ListRng.ClearContents


  Set MasterSht = MelWB.Sheets("Master P&ID List")
  Set Cel = MasterSht.Range("PIDEquip_hdr").Offset(1, 0)  'This is also a named range
  Set MasterRng = Range(Cel, Cel.Offset(1000000, 0).End(xlUp).Offset(0, 4))


  MasterRng.Copy
  ListSht.Range("PIDEquip_hdr").Offset(1, 0).PasteSpecial xlPasteValues


  'This is the next table to update


  'Equipment Type List @@@@@@ Equipment Type List @@@@@@ Equipment Type List @@@@@@ Equipment Type List @@@@@@
  Set ListSht = ThisWorkbook.Sheets("Setup")
  Set Cel = ListSht.Range("TypeList_hdr").Offset(1, 0)
  Set ListRng = Range(Cel, Cel.Offset(1000, 0))
  ListRng.ClearContents
  Cel.Value = "All"


  Set MasterSht = MelWB.Sheets("Other List")
  Set Cel = MasterSht.Range("TypeList_hdr").Offset(1, 0)
  Set MasterRng = Range(Cel, Cel.Offset(100000, 0).End(xlUp))
  MasterRng.Copy
  ListSht.Range("TypeList_hdr").Offset(2, 0).PasteSpecial xlPasteValues




  'And the next


  'Master Equipment List..........Master Equipment List..........Master Equipment List..........
  Application.StatusBar = "Retrieving Master Equipment List.  This may take up to 5 seconds"
  Set ListSht = ThisWB.Sheets("Master Equipment List")
  Set Cel = ListSht.Range("FuncLoc_hdr").Offset(1, 0)
  Set ListRng = Range(Cel, Cel.Offset(1000000, 20))
  ListRng.ClearContents


  Set MasterSht = MelWB.Sheets("Master Equip List")
  Set Cel = MasterSht.Range("FunctionalLoc_hdr").Offset(1, 0)
  Set MasterRng = Range(Cel, Cel.Offset(1000000, 0).End(xlUp).Offset(1000, 20))


  'Copy the table from the master to this wb
  MasterRng.Copy
  ListSht.Range("FuncLoc_hdr").Offset(1, 0).PasteSpecial xlPasteValues


  Application.DisplayAlerts = False
  Application.CutCopyMode = False
  '---------------------
  MelWB.Close savechanges:=False
  '---------------------


  'You can delete this part of the code if you don't need to sort

'--------------------------------------------------------------------------------------------------
  Application.StatusBar = "Sorting Master Equipment List and checking file status..."
  'Sort the master equipment list
  Set Cel = ListSht.Range("FuncLoc_hdr")
  Set i = Intersect(Cel.End(xlDown).EntireRow, Cel.End(xlToRight).EntireColumn)
  Set R = Range(Cel, i)
  Set Cel = ListSht.Range("Block_hdr")
  Set Key1 = Range(Cel, Cel.End(xlDown))
  Set Cel = ListSht.Range("Equip_hdr")
  Set Key2 = Range(Cel, Cel.End(xlDown))
  Set Cel = ListSht.Range("WorkScope_hdr")
  Set Key3 = Range(Cel, Cel.End(xlDown))


  ListSht.Sort.SortFields.Clear
  ListSht.Sort.SortFields.Add Key:=Key1, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  ListSht.Sort.SortFields.Add Key:=Key2, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  ListSht.Sort.SortFields.Add Key:=Key3, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ListSht.Sort
      .SetRange R
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
  End With
'---------------------------------------------------------------------------------

  Application.DisplayAlerts = True


  LastSht.Activate


  Call EventsOn
  Application.StatusBar = False








End Sub

Supporting Functions

'Check to see if current user has file open
Function IsWBOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
    On Error Resume Next
    IsWBOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function




'Checks to see if file is open by another user or by current user
Function IsFileOpen(FileName As String) As Integer
    Dim filenum As Integer, errnum As Integer


    On Error Resume Next    ' Turn error checking off.
    filenum = FreeFile()    ' Get a free file number.
    
                            ' Attempt to open the file and lock it.
    Open FileName For Input Lock Read As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=filenum]#filenum[/URL] 
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.


    ' Check to see which error occurred.
    Select Case errnum


        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
         IsFileOpen = 0


        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        Case 70
            IsFileOpen = errnum
'            If IsWBOpen(GetFileName(FileName)) = True Then
'              IsFileOpen = -1
'            Else
'              IsFileOpen = 1
'            End If


        ' Another error occurred.
        Case Else
            IsFileOpen = errnum
    End Select


End Function






Function GetFileName(PathFile As String) As String


  Dim X As Long
  Dim A As String
  Dim BS As Integer
  
  A = PathFile
  For X = Len(A) To 1 Step -1
    If Mid(A, X, 1) = "" Then
      BS = X + 1
      Exit For
    End If
  Next X
  If BS > 0 Then
    GetFileName = Mid(A, BS)
  Else
    GetFileName = A
  End If
End Function






Function GetPath(PathFile As String) As String


  Dim X As Long
  Dim A As String
  Dim BS As Integer
  
  A = PathFile
  For X = 1 To Len(A)
    If Mid(A, X, 1) = "" Then
      BS = X
    End If
  Next X
  If BS > 0 Then
    GetPath = Left(A, BS)
  Else
    GetPath = A & ""
  End If
End Function








Function GetRootName(ByVal FileExt As String) As String
  Dim X As Long
  
  If InStr(FileExt, ".") = 0 Then
    GetRootName = FileExt
    Exit Function
  End If
  For X = Len(FileExt) To 1 Step -1
    If Mid(FileExt, X, 1) = "." Then
      GetRootName = Left(FileExt, X - 1)
      Exit Function
    End If
  Next X
  
  
End Function