Create copy workbook with cell referencing to original

[Faith]

Hello,

At my work we are using Excel as a CMS to produce SQL scripts for insertion into a database. The data is then turned into mobile web pages. This involves multiple workbooks - 1 for each main page with the sub-pages as extra worksheets in the book.

Much of the data is duplicated so we have created master workbooks then copied them and laboriously referenced the relevant cells back to the original. That way if any data in the master is changed, all copies will change simultaneously.

This is obviously not the most efficient way of publishing web pages but we are stuck with it for now. So I am wondering if it is possible to write a VBA code to create a copy of the master and then reference all required tables in the worksheets automatically? The tables are all named ranges.

Any help is really appreciated.

 

[Faith]

Ok so I ran it again with no error! I could see at the bottom left it made copy 1 of 2 then 2 of 2 and updated 152 named ranges. There are also 152 named ranges listed in the journal on the copier book. But the copies do not reference the named ranges on the master. So while the macro looks like it works, it still isn't doing what it's supposed to.

I will email you my master copy again because I made a couple changes to it.

 

[pbornemeier]

When I run the program the named ranges in the copies are modified to reference the named ranges for the corresponding worksheet!cells on the master.
When I check the name manager, I can see the new location and the values on the master for those worksheet!cells.

The cells on each copy that were in the copy's named ranges now have nothing to do with that worksheet's named ranges (all which now reference the Master named ranges.)

If you want the cells on the copies to actually reflect the corresponding cell values on the Master then I can do one of the following:
1) add code to put formulas similar to =[Master.xlsm]Lookups!F2 in Lookups!F2 of each copy (likewise for all other cells in the former named ranges).
2) Copy the existing values for involved cells when the copy is first made
3) Add code to copy the current values from the named ranges of the master each time a copy is open. Note that this would not update while the copy was open.
4) Add code to copy the current values from the named ranges of the master on demand.
5) a combination of 3 and 4

 

[Faith]

Oh yes I see that the named ranges are referencing the master now. But it's a bit confusing not being able to see anything in the tables themselves.

How hard is it to do option 1? Would it dynamically update if you opened the master and the copy at the same time, changed the master and saved? Would that show the values of what is in the cells in the Master?

 

[pbornemeier]

Option 1 (actually any of them) can be done easily, but it would result in many formulae. If auto recalculation is turned on, it would take some amount of time to recalculate each time any cell was updated. If auto recalculation was off you would have to train people to ensure they manually triggered recalculation before relying on any values. Code could be added to trigger recalculation on open, save or print (or several other events). I don't know how long recalculation would take. It would depend on what other formulas and event-driven code you had in your workbook.

 

[Faith]

I think this is the way we had it working before, all the cells looked like =[Master]Page etc so if we had the master and copy open together and changed the master, the copy would automatically change when the master was updated. It never seemed too slow. Or is your solution different?

 

[pbornemeier]

I had thought that 8100+ references to another workbook might be slow. I will modify the code to to add the reference to the master worksheet in each cell in the (formerly) named ranges.

After I set up the code that way you may want to test which of the following setups result in best performance:

1) Having local named ranges refer to local cells each which contain a formula referencing corresponding cells in the master
2) Having (formerly) named ranges in each copy refer to the master named range instead.

The named range modification and the addition of cell references in the formerly named ranges will be in separate sections of the code, so you will be able to test it with your real data by commenting out the named range reassignment

 

[pbornemeier]

Please test and let me know how it works. Note that I removed data validation from the named range cells in the copies since it does not support formulas.

Option Explicit

Sub CreateCopiesWithNamedRangesReferencingMaster()
    'Create a new workbook named Copier.xlsm, add a standard module and put this code in it.
    'Save Copier.xlsm in the same directory as the Master file.  Copies will be created in that directory

    Dim aryCopyNames As Variant
    Dim lX As Long, lY As Long
    Dim sCopyName As String
    Dim secAutomation As MsoAutomationSecurity
    Dim sExtension As String
    Dim sMasterFileName As String
    Dim lNameCount As Long
    Dim lCopyCount As Long
    Dim lNextWriteRow As Long
    
    'Create a Journal worksheet in thisworkbook
    With ThisWorkbook
        On Error Resume Next
        Application.DisplayAlerts = False
        .Worksheets("Journal_PAB").Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
        .Worksheets.Add(Before:=.Sheets(1)).Name = "Journal_PAB"
        .Worksheets("Journal_PAB").Range("A1").Resize(1, 6).Value = Array("lX", "lY", "File", ".Name", "Original .RefersTo", "Updated .RefersTo")
    End With
    lNextWriteRow = 1
    
    'Modify the next line to contain the name of the Master workbook, be sure to include the extension
    sMasterFileName = "Master.xlsm"
    'An example for the above line would be sMasterFileName = "Master.xlsx"
    
    'Modify next line to contain names of each copy. extension will be copied from the extension in sMasterFileName
    aryCopyNames = Array("CopyA", "CopyB")
    'An example for the above line would be aryCopyNames = Array("CopyA", "CopyB", "CopyC")

    secAutomation = Application.AutomationSecurity                          'Save ThisWorkbook security setting
    Application.AutomationSecurity = msoAutomationSecurityForceDisable      'Disable macros when opening file
    
    sExtension = Mid(sMasterFileName, InStrRev(sMasterFileName, "."))
    
    'Open the master file
    Workbooks.Open Filename:=ThisWorkbook.Path & "\" & sMasterFileName
    
    For lX = LBound(aryCopyNames) To UBound(aryCopyNames)
    
        If UCase(Right(aryCopyNames(lX), Len(sExtension))) <> UCase(sExtension) Then
            sCopyName = aryCopyNames(lX) & sExtension
        Else
            sCopyName = aryCopyNames(lX)
        End If

        'Save a copy of the master file
         Workbooks(sMasterFileName).SaveCopyAs Filename:=ThisWorkbook.Path & "\" & sCopyName
        'Open the copy
        Workbooks.Open Filename:=ThisWorkbook.Path & "\" & sCopyName
        
        'Add formulas referencing corresponding cells in the Master to each cell of each named range in the copy
        '  Comment out next line if you do not want the formulas in each copy's named range cells
        MakeNamedRangesCellsReferenceMaster
        
        'Update named ranges in the copy
        lNameCount = Workbooks(sMasterFileName).Names.Count
        lCopyCount = UBound(aryCopyNames) + 1
        For lY = 1 To lNameCount
            With Workbooks(sCopyName).Names(lY)
                
                'Update journal with value about to be changed
                lNextWriteRow = lNextWriteRow + 1
                With ThisWorkbook
                    .Worksheets("Journal_PAB").Cells(lNextWriteRow, 1) = lX
                    .Worksheets("Journal_PAB").Cells(lNextWriteRow, 2) = lY
                    .Worksheets("Journal_PAB").Cells(lNextWriteRow, 3) = aryCopyNames(lX)
                    .Worksheets("Journal_PAB").Cells(lNextWriteRow, 4) = "'" & Workbooks(sCopyName).Names(lY).Name
                    .Worksheets("Journal_PAB").Cells(lNextWriteRow, 5) = "'" & Workbooks(sCopyName).Names(lY).RefersTo
                End With
                
                '.RefersTo = "=[" & sMasterFileName & "]" & Mid(.RefersTo, 2) 'Original
                If InStr(.RefersTo, "'") > 0 Then
                    'worksheet name contains at least 1 space (and therefore contains a single quote)
                    .RefersTo = "='[" & sMasterFileName & "]" & Mid(.RefersTo, 3)
                Else
                    'Named range does not have a space
                    .RefersTo = "=[" & sMasterFileName & "]" & Mid(.RefersTo, 2) 'Original (no space in worksheet name)
                End If
                Application.StatusBar = "Copy " & lX + 1 & " of " & lCopyCount & ":  Updated named range " & lY & " of " & lNameCount & "  " & .RefersTo
                DoEvents
                With ThisWorkbook
                    .Worksheets("Journal_PAB").Cells(lNextWriteRow, 6) = "'" & Workbooks(sCopyName).Names(lY).RefersTo
                End With
                
            End With
        Next
        
        'Save and close the copy
        Workbooks(sCopyName).Save
        Workbooks(sCopyName).Close
    Next
    
    'Close the master file
    Workbooks(sMasterFileName).Close
    Worksheets("Journal_PAB").UsedRange.Columns.AutoFit
    
End_Sub:
    
    Application.AutomationSecurity = secAutomation                          'Restore ThisWorkbook security setting
    Application.StatusBar = False
End Sub

Sub MakeNamedRangesCellsReferenceMaster()
    'The data validation for each named range cell in the copy will be removed since it is not compatible with formulas
    
    Dim lCellCount As Long
    Dim lRangeCount As Long
    Dim nm As Name
    Dim rngCell As Range
    
    For Each nm In ActiveWorkbook.Names
        For Each rngCell In nm.RefersToRange
            rngCell.Validation.Delete
            rngCell.FormulaR1C1 = "='[Master.xlsm]" & rngCell.Worksheet.Name & "'!" & rngCell.Address(, , xlR1C1)
        Next
    Next

End Sub

Sub Document_ListActiveWorkbookNamedRangesOnAWorksheet()

    Dim lX As Long
    
    'Initialize Documentation Worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Document_NamedRanges").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Worksheets.Add(Before:=Sheets(1)).Name = "Document_NamedRanges"
    
    With Worksheets("Document_NamedRanges")
        .Range("A1").Resize(1, 5).Value = Array("Name", "RefersToR1C1", "RefersTo", "Value", "Comment")
        
        'Examine each named range
        For lX = 1 To ActiveWorkbook.Names.Count
            With ActiveWorkbook.Names(lX)
                Worksheets("Document_NamedRanges").Cells(lX + 1, 1).Value = .Name
                Worksheets("Document_NamedRanges").Cells(lX + 1, 2).Value = "'" & .RefersToR1C1
                Worksheets("Document_NamedRanges").Cells(lX + 1, 3).Value = "'" & .RefersTo
                Worksheets("Document_NamedRanges").Cells(lX + 1, 4).Value = .Value
                Worksheets("Document_NamedRanges").Cells(lX + 1, 5).Value = .Comment
                Debug.Print .Name, .RefersTo
            End With
        Next
        .UsedRange.Columns.AutoFit
    End With
        
End Sub

Sub CountCellsInNamedRanges()

    Dim lCellCount As Long
    Dim lRangeCount As Long
    Dim nm As Name
    
    For Each nm In ActiveWorkbook.Names
        lRangeCount = lRangeCount + 1
        lCellCount = lCellCount + nm.RefersToRange.Cells.Count
    Next
    Debug.Print lRangeCount, lCellCount

End Sub