#REF! in formula after merging a workbook in Excel - 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

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:
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
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

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

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.