#REF! in formula after merging a workbook in Excel

Question

I'm merging Excel workbooks into one "summary.xls" using a VBA macro. The macro is executed from another open workbook. This original workbook has some formulas containing links to "summary" (like ='C:\[Summary.xls]Cell'!E3). For the process of merging, the original workbook "summary.xls" is deleted and rewritten. After rewriting all the formulas with the original links to summary have #ref! written in it and are broken and can not be automatically updated (='C:\[Summary.xls]#REF'!E4). The following passage is the one causing the mistake:

        Workbooks(Filename).Close (False) 'add False to close without saving
 '       Kill srcFile                      'deletes the file
        Filename = Dir()

Does somebody has a suggestion how to solve the problem?

Whole code is based on that suggestion:

Option Explicit

Function IsSheetEmpty(sht As Worksheet) As Boolean
    IsSheetEmpty = Application.WorksheetFunction.CountA(sht.Cells) = 0
End Function

Sub GetSheets()
    Dim Path, Filename As String
    Dim Sheet As Worksheet
    Dim newBook As Workbook
    Dim appSheets As Integer
    Dim srcFile As String
    Dim dstFile As String

    Application.ScreenUpdating = False  'go faster by not waiting for display

    '--- create a new workbook with only one worksheet
    dstFile = ActiveWorkbook.Path & "AllSheetsHere.xlsx"
    If Dir(dstFile) <> "" Then
        Kill dstFile     'delete the file if it already exists
    End If
    appSheets = Application.SheetsInNewWorkbook  'saves the default number of new sheets
    Application.SheetsInNewWorkbook = 1          'force only one new sheet
    Set newBook = Application.Workbooks.Add
    newBook.SaveAs dstFile
    Application.SheetsInNewWorkbook = appSheets  'restores the default number of new sheets

    Path = "C:\Temp\"
    Filename = Dir(Path & "*.xls?")  'add the ? to pick up *.xlsx and *.xlsm files
    Do While Filename <> ""
        srcFile = Path & Filename
        Workbooks.Open Filename:=srcFile, ReadOnly:=True
        For Each Sheet In ActiveWorkbook.Sheets
            '--- potentially check for blank sheets, or only sheets
            '    with specific data on them
            If Not IsSheetEmpty(Sheet) Then
                Sheet.Copy After:=newBook.Sheets(1)
            End If
        Next Sheet
        Workbooks(Filename).Close (False) 'add False to close without saving
        Kill srcFile                      'deletes the file
        Filename = Dir()
    Loop
    '--- delete the original empty worksheet and save the book
    newBook.Sheets(1).Delete
    newBook.Save
    newBook.Close

    Application.ScreenUpdating = True 're-enable screen updates
End Sub

Answer 1

I've added a further workbook containig the referencins formulas. This one is closed during the whole procedure of deleting and summarizing the worksheets. The new workbook opens after this, therefore the referencing mistake is avoided.

Answer 2

If you still have reference in your workbook to the cells being referenced (and from your example, you do), and if all of your #REF! errors used to point to a single sheet, there is an easy fix.

CTRL+H brings up the REPLACE function.

Simply enter #REF! in the "find" box, and Sheet1 in the "replace" box, and all references will now point to sheet1 in the same summary.xls workbook.

Answer 3

Internal sheet-to-sheet references within a workbook (Book1.xlsx) generally look like this:

=ABC!B23

But if you copy the worksheet with that reference to a new workbook, Excel will change it to an external reference back to the original workbook:

='[Book1.xlsx]ABC'!B23

There are several restrictions you'll have to place on references in your worksheets that you're copying into the single new workbook:

1. All sheet names in the destination workbook MUST be unique
   • Sheets named "ABC" in Book1 and "ABC" in Book2 would cause reference collisions in the destination workbook
   • One of the sheets must be renamed into a unique string
2. Sheet-to-sheet references that are completely internal to a workbook can be converted into similar references in the destination. References to external worksheets (in a different workbook) may be problematic and could require lots of additional logic to handle.

One option is to perform a wildcard search and replace on a worksheet after the Sheet.Copy is performed. The requirement here is that any sheet that is referenced must already be local to the new sheet in the destination book. (Otherwise, the "fixed-up" reference will still give you a #REF error.)

Sub test()
    Dim area As Range
    Dim farea As Range
    '--- determines the entire used area of the worksheet
    Set area = Range("A1").Resize(Cells.Find(What:="*", SearchOrder:=xlRows, _
                           SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
                           Cells.Find(What:="*", SearchOrder:=xlByColumns, _
                           SearchDirection:=xlPrevious, LookIn:=xlValues).Column)
    '--- replaces all external references to make them internal references
    area.Replace What:="[*]", Replacement:=""
End Sub

The other option is much cleaner and a neat trick. When you're copying worksheets into a new workbook, if you copy ALL the sheets in a single action then Excel preserves the sheet-to-sheet references as internal (and doesn't replace each reference with a filename prefix) because it knows that the sheet references will be there in the new workbook. Here's that solution in your code:

Option Explicit

Function IsSheetEmpty(sht As Worksheet) As Boolean
    IsSheetEmpty = Application.WorksheetFunction.CountA(sht.Cells) = 0
End Function

Sub GetSheets()
    Dim i As Integer
    Dim Path, Filename As String
    Dim sh As Worksheet
    Dim newBook As Workbook
    Dim appSheets As Integer
    Dim srcFile As String
    Dim dstFile As String
    Dim dstPath As String
    Dim wasntAlreadyOpen As Boolean
    Dim name As Variant
    Dim allSheetNames As Dictionary  'check VBA Editor->Tools->References->Microsoft Scripting Runtime
    Dim newSheetNames As Dictionary
    Dim newNames() As String

    Application.ScreenUpdating = False  'go faster by not waiting for display

    '--- create a new workbook with only one worksheet
    dstFile = "AllSheetsHere.xlsx"
    dstPath = ActiveWorkbook.Path & "\" & dstFile
    wasntAlreadyOpen = True
    If Dir(dstPath) = "" Then
        '--- the destination workbook does not (yet) exist, so create it
        appSheets = Application.SheetsInNewWorkbook  'saves the default number of new sheets
        Application.SheetsInNewWorkbook = 1          'force only one new sheet
        Set newBook = Application.Workbooks.Add
        newBook.SaveAs dstPath
        Application.SheetsInNewWorkbook = appSheets  'restores the default number of new sheets
    Else
        '--- the destination workbook exists, so ...
        On Error Resume Next
        wasntAlreadyOpen = False
        Set newBook = Workbooks(dstFile)             'connect if already open
        If newBook Is Nothing Then
            Set newBook = Workbooks.Open(dstPath)    'open if needed
            wasntAlreadyOpen = True
        End If
        On Error GoTo 0
        '--- make sure to delete any/all worksheets so we're only left
        '    with a single empty sheet named "Sheet1"
        Application.DisplayAlerts = False            'we dont need to see the warning message
        Do While newBook.Sheets.Count > 1
            newBook.Sheets(newBook.Sheets.Count).Delete
        Loop
        newBook.Sheets(1).name = "Sheet1"
        newBook.Sheets(1).Cells.ClearContents
        newBook.Sheets(1).Cells.ClearFormats
        Application.DisplayAlerts = True             'turn alerts back on
    End If

    '--- create the collections of sheet names...
    '    we need to make sure that all of the sheets added to the newBook have unique
    '    names so that any formula references between sheets will work properly
    '    LIMITATION: this assumes sheet-to-sheet references only exist internal to
    '                a single workbook. External references to sheets outside of the
    '                source workbook are unsupported in this fix-up
    Set allSheetNames = New Dictionary
    allSheetNames.Add "Sheet1", 1

    Path = "C:\Temp\"
    Filename = Dir(Path & "*.xls?")  'add the ? to pick up *.xlsx and *.xlsm files
    Do While Filename <> ""
        srcFile = Path & Filename
        Workbooks.Open Filename:=srcFile, ReadOnly:=True
        '--- first make sure all the sheet names are unique in the destination book
        Set newSheetNames = New Dictionary
        For Each sh In ActiveWorkbook.Sheets
            If Not IsSheetEmpty(sh) Then
                '--- loop until we get a unique name
                i = 0
                Do While allSheetNames.Exists(sh.name)
                    sh.name = sh.name & "_" & i        'rename until unique
                    i = i + 1
                Loop
                allSheetNames.Add sh.name, i
                newSheetNames.Add sh.name, i
            End If
        Next sh
        '--- we're going to copy ALL of the non-empty sheets to the new workbook with
        '    a single statement. the advantage of this method is that all sheet-to-sheet
        '    references are preserved between the sheets in the new workbook WITHOUT
        '    those references changed into external references
        ReDim newNames(0 To newSheetNames.Count - 1)
        i = 0
        For Each name In newSheetNames.Keys
            newNames(i) = name
            i = i + 1
        Next name
        ActiveWorkbook.Sheets(newNames).Copy After:=newBook.Sheets(1)

        Workbooks(Filename).Close (False) 'add False to close without saving
        Kill srcFile                      'deletes the file
        '--- get the next file that matches
        Filename = Dir()
    Loop
    '--- delete the original empty worksheet and save the book
    If newBook.Sheets.Count > 1 Then
        newBook.Sheets(1).Delete
    End If
    newBook.Save
    '--- leave it open if it was already open when we started
    If wasntAlreadyOpen Then
        newBook.Close
    End If

    Application.ScreenUpdating = True 're-enable screen updates
End Sub