0

I created a macro-enabled Excel workbook (I'll call it NewData.xlsm) that has a refresh button that when you click it, it connects to the source file in a network folder (Source.xlsm). I shared the NewData.xlsm with my co-workers and they all have a copy of it stored in their computer. I update the source.xlsm file on a monthly basis and my co-workers get the new data by opening their NewData.xlsm file and connecting to Source.xlsm when they click on the refresh button on NewData.xlsm.

The source file is located on a network folder that all the users have access to through VPN.

It works well when everyone tries it individually at different times. The problem happens when:

  • Person #1 opens their copy of NewData.xlsm and updates it without issues and not requiring to enter credentials.
  • Person #2, opens their copy of NewData.xlsm and tries updating it while Person #1 is still using it. Person #2 then gets asked to provide a username and password, but the file doesn't require that. If they provide their Windows credentials, nothing happens and there is no way for them to update the file but until Person #1 closes their NewData.xlsm file.

I want to allow multiple users to connect to the source at the same time without issues. I know that is possible, because I use another Excel (ExcelThatWorks.xlsm), created by someone else, that allows that, but I don't find the way to make my NewData.xlsm to do the same. If I don't achieve that, then the users will have to access the file on a schedule and that is unacceptable.

I did see in the ExcelThatWorks.xlsm file, that there is a code that says OLEDBConnection (I added the code below), and thought that probably that's what I need, but I'm not sure, because I'm using VBA.

I'm using Office LTSC Professional Plus 2021 on Windows 10 Enterprise.

These are all the codes I have on the NewData.xlsm file and it works flawlessly when one person uses it at a time, but not when more than one person opens it simultaneously.

______________________________________
Option Explicit
 
Public Sub Stop_ScreenUpdateOpen()
    Application.ScreenUpdating = False
'Open a workbook
 
  'Open method requires full file path to be referenced.
  Workbooks.Open "\\Full\Shared\Folder\Path\Source.xlsm"
    
    Application.ScreenUpdating = True
End Sub
______________________________________
 
Public Sub Stop_ScreenUpdateCopyPasteRaw()
 
Dim s As Workbook
Dim d As Workbook
Dim vals As Variant
 
 
'## Open both workbooks first:
Set s = Workbooks.Open("\\Full\Shared\Folder\Path\Source.xlsm ")
Set d = ThisWorkbook
 
 
With s.Sheets("RAW").UsedRange
    'Now, paste to d worksheet:
    d.Sheets("RAW").Range("A1").Resize( _
        .Rows.Count, .Columns.Count) = .Value
End With
 
End Sub
 
______________________________________
 
Public Sub Stop_ScreenUpdateCopyPasteData()
 
Dim s As Workbook
Dim d As Workbook
Dim vals As Variant
 
 
'## Open both workbooks first:
Set s = Workbooks.Open("\\Full\Shared\Folder\Path\Source.xlsm ")
Set d = ThisWorkbook
 
 
With s.Sheets("Data").Range("A2:j200")
    'Now, paste to d worksheet:
    d.Sheets("Data").Range("A2").Resize( _
        .Rows.Count, .Columns.Count) = .Value
End With
 
End Sub
______________________________________
 
Public Sub Stop_ScreenUpdateClose()
    Application.ScreenUpdating = False
'Close a workbook
 
  Workbooks("Source.xlsm").Close SaveChanges:=False
    
    Application.ScreenUpdating = True
End Sub
______________________________________
 
Public Sub RefreshConnections()
    ActiveSheet.PivotTables("PivotTable1").RefreshTable
 
    MsgBox "Data has been refreshed!"
 
End Sub
______________________________________
 
CALL Method
 
Public Sub Stop_ScreenUpdateUpdate()
    Application.ScreenUpdating = False
 
Call Stop_ScreenUpdateOpen
 
Call Stop_ScreenUpdateCopyPasteRaw
 
Call Stop_ScreenUpdateCopyPasteData
 
Call Stop_ScreenUpdateClose
 
Call RefreshConnections
 
 
    Application.ScreenUpdating = True
End Sub
______________________________________

The ExcelThatWorks.xlsm file that I mentioned above has this code:

______________________________________
Public Sub UpdatePowerQueries()
' Macro to update my Power Query script(s)
 
Dim lTest As Long, cn As WorkbookConnection
On Error Resume Next
For Each cn In ThisWorkbook.Connections
lTest = InStr(1, cn.OLEDBConnection.Connection, "Provider=Microsoft.Mashup.OleDb.1", vbTextCompare)
If Err.Number <> 0 Then
Err.Clear
Exit For
End If
If lTest > 0 Then cn.Refresh
Next cn
 
End Sub
______________________________________

It has no other code, only that and works like a charm. But I have no idea how to achieve the same result.

I checked Update an excel file by multiple users at same time without opening the file and other threads presented to me before submitting this question but all refer to users editing the source file.

My users are not adding/removing any info from the source file, they are just pulling the new data from the source file, and don't need to edit anything on it.

Adding to this, that when I have the NewData.xlsm file opened and try to open the Source.xlsm file it shows a pop up saying that it is locked for editing and asks to open an Read-Only or click notify.locked for editing by 'another user'

Do you want to connect to Source 001 Clicking Yes, asks for credentials 002 [More cred][4]

Not letting me add more photos but it then says the source file is not found and asks if I want to connect to another source. When I say no, it says that Excel cannot open the connection and cannot refresh.

Carelita
  • 1
  • 3
  • 1
    @jonrsharpe thanks for editing my question. It looks a lot better now. – Carelita Apr 22 '23 at 16:40
  • Have you considered opening source as read only? – chris neilsen Apr 22 '23 at 20:55
  • Hi @chris,Thanks for replying. I can try that. How do I do it? What code can I use to do that? – Carelita Apr 22 '23 at 22:32
  • I tried with this code: Public Sub Stop_ScreenUpdateOpen() Application.ScreenUpdating = False Dim s As Workbook Dim filepath As String filepath = "\\Full\Shared\Folder\Path\Source.xlsm" Set s = Workbooks.Open(Filename:=filepath, ReadOnly:=True) Application.ScreenUpdating = True End Sub It does work, the only thing is that it is showing the Read-Ony file when it opens. Before, it was opening and closing in the background. Any way to make it open in the background and then closing without showing the activity to the user? – Carelita Apr 23 '23 at 00:21
  • Just after`.Open ...` add `ActiveWindow.Visible = False` – chris neilsen Apr 23 '23 at 00:39
  • That's awesome, it worked. Tomorrow I'll try asking a co-worker to open the file and update it while I have it opened to see if opening the source as Read-Only solves the issue of multiple users simultaneously and I'll update here. Thanks a lot! – Carelita Apr 23 '23 at 01:03
  • Hello, I asked a coworker to open and refresh the file now with the source opening as Read-Only. It worked perfectly for her. But I told her to leave it open and I opened mine on my computer, when I tried to refresh, it presented the same pop ups like before, asking for credentials and the file didn't update. I'm adding the pictures. – Carelita Apr 23 '23 at 20:10
  • @chris neilsen I don't see a green check to mark your answer as the solution but, I changed the code and is a lot shorter, but added to open the source file as Read Only and tried it with my co-workers. The reason it didn't work before was that in my code I had to open the file twice and I added the ReadOnly on one but not on the other code. – Carelita Apr 25 '23 at 20:05
  • I don't have time to write up an answer right now. How about you write an answer yourself. – chris neilsen Apr 25 '23 at 20:08

1 Answers1

0

I want to thank @chris neilsen for his answer. I don't have the option to mark his answer as the resolution, but this is the code that is now working:

  Public Sub CopyData()
    Application.ScreenUpdating = False

    Dim filename As String
    filename = "\\full\source\folder\Path\Source.xlsm"

    Dim wk As Workbook
    Set wk = Workbooks.Open(filename, ReadOnly:=True)
    ActiveWindow.Visible = False


    Dim rgSource As Range, rgDestination As Range, s As Workbook


'Set a rgSource = [workbook].[worksheet].[range]


    Set rgSource = wk.Worksheets("RAW").Range("A2:K8000")
    Set rgDestination = ThisWorkbook.Worksheets("RAW").Range("A2")

    rgSource.Copy
    rgDestination.PasteSpecial xlPasteValues


    Set rgSource = wk.Worksheets("Data").Range("A2:j200")
    Set rgDestination = ThisWorkbook.Worksheets("Data").Range("A2")

    rgSource.Copy
    rgDestination.PasteSpecial xlPasteValues

    Application.DisplayAlerts = False

    wk.Close saveChanges:=False

    Application.ScreenUpdating = True

    End Sub

Public Sub RefreshPivotTables()
    Dim PT As PivotTable
    Dim WS As Worksheet

    For Each WS In ThisWorkbook.Worksheets
        If WS.Name <> "PivotTable4" Then
        For Each PT In WS.PivotTables
            PT.RefreshTable
        Next PT
        End If
    Next WS

    MsgBox "Data has been refreshed!"

End Sub
Carelita
  • 1
  • 3