Consulting

Results 1 to 1 of 1

Thread: Accessing a network file that might already be open by another user

  1. #1

    Accessing a network file that might already be open by another user

    Hello All
    I usually find the code I need from the net as I am not that good at VBA.

    I have the following request; how can I adapt this wonderful code:
    1. To open another network file so that I can extract the relevant data. Being on a network there is the possibiliy that another user may have it open in which case I will be offered to open it as read only.
    2. Extract the values from it - currently the code just links the relevant cells
    3. Close the data workbook when extractions are complete.

    I hope this makes sense and many thanks in advance for any takers.

    Angelo

    Code

    Sub Summary_All_Worksheets_With_Formulas()
        Dim Sh As Worksheet
        Dim Newsh As Worksheet
        Dim myCell As Range
        Dim ColNum As Integer
        Dim RwNum As Long
        Dim Basebook As Workbook
    
        With Application
            .Calculation = xlCalculationManual
            .ScreenUpdating = False
        End With
    
        'Delete the sheet "Summary-Sheet" if it exist
        Application.DisplayAlerts = False
        On Error Resume Next
        ThisWorkbook.Worksheets("Summary-Sheet").Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
    
        'Add a worksheet with the name "Summary-Sheet"
        Set Basebook = ThisWorkbook
        Set Newsh = Basebook.Worksheets.Add
        Newsh.Name = "Summary-Sheet"
    
        'The links to the first sheet will start in row 2
        RwNum = 1
    
        For Each Sh In Basebook.Worksheets
            If Sh.Name <> Newsh.Name And Sh.Visible Then
                ColNum = 1
                RwNum = RwNum + 1
                'Copy the sheet name in the A column
                Newsh.Cells(RwNum, 1).Value = Sh.Name
    
                For Each myCell In Sh.Range("A1,D5:E5,Z10")  
                    ColNum = ColNum + 1
                    Newsh.Cells(RwNum, ColNum).Formula = _
                    "='" & Sh.Name & "'!" & myCell.Address(False, False) 'this is the section that I need changed
                Next myCell
    
            End If
        Next Sh
    
        Newsh.UsedRange.Columns.AutoFit
    
        With Application
            .Calculation = xlCalculationAutomatic
            .ScreenUpdating = True
        End With
    End Sub
    Last edited by Bob Phillips; 05-07-2017 at 11:45 AM. Reason: Added code tags

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •