How to Recreate a Sheet and Keep References Valid?

Question

I have a client who is hand holding a bunch of worksheets that should be standardized. They are created from importing CSV files. Basically, I need to replace the current manual sheets while they are being referenced from another tab without breaking the current references.

I've reduced the problem to a single workbook with 2 sheets. Sheet1 cell A1 references Sheet2 cell A1 which holds the string "Sheet2A1CellData"

Everything commented out below has been tried including Application.Volatile and Application.Calculation.

Option Explicit
Sub TestSheet2Delete()
  Dim TmpSheet2 As Worksheet: Set TmpSheet2 = Sheets("Sheet2")

  'Application.Volatile

  If TmpSheet2 Is Nothing Then
    Exit Sub
  End If

  'Application.Calculation = False

  Application.DisplayAlerts = False
  TmpSheet2.Delete
  Application.DisplayAlerts = True

  Set TmpSheet2 = Worksheets.Add(After:=Sheets("Sheet1"))

  If TmpSheet2 Is Nothing Then
    Exit Sub
  End If

  TmpSheet2.Name = "Sheet2"
  TmpSheet2.Range("A1").Value = "Sheet2A1CellData"

  'Application.Calculation = True
End Sub

Sheet1 A1 was originally =Sheet2!A1. When I run the function above from the VBE, Sheet1 cell A1 is set to =#REF!A1.

How can I keep the reference valid after the sheet has been replaced?

Obviously, the real world problem is much larger and re-importing CSV data requires updating 132,000 cells. 6000 rows x 22 Columns.

Thanks for any help.

Answer 1

AFTER I posted (of course :-)), this link came up on the right: Preserve references that recommends using INDIRECT. I have now changed Sheet1 A1 to =INDIRECT("Sheet2!"&"A1").

I am not certain why the named ranges suggested in the link are needed. The indirect call above seems to work without a named range.

If this works in the larger project, I will mark this as complete.

Answer 2

Thank you presenting a real good question.

First of all disclaimer: This is not an direct solution but and workaround we had to adopt years back.

Exactly similar problem problem had been encountered in my workplace (literally made us to pull out our hairs), and we also tried to go for iNDIRECT. But since the formulas in the working sheets are complex we failed to replace them with INDIRECT. So instead of lengthy manual replacement of the hundreds of Formulas in the working sheet, we used to insert a temp Sheet and change the formulas reference to that sheet. After importing new sheet and renaming it as old sheet's name, formulas were reverted back to original. I tried to reproduce the code used (since I don't have access to same files now). We only used the Sub ChangeFormulas, Here I used the same in line with your code.

Option Explicit
Sub TestSheet2Delete()
Dim Wb As Workbook
Dim Ws As Worksheet, Ws1 As Worksheet, Ws2 As Worksheet
Dim Xstr As String, Ystr As String
Set Wb = ThisWorkbook
Set Ws = Wb.Sheets("Sheet1")

Xstr = "Sheet2"
Ystr = "TempSheetX"
Set Ws1 = Wb.Sheets(Xstr)

Set Ws2 = Worksheets.Add(After:=Ws)
Ws2.Name = Ystr
DoEvents
ChangeFormulas Ws, Xstr, Ystr

Application.DisplayAlerts = False
Ws1.Delete

' Now again add another sheet with Old name and change formulas back to Original
Set Ws1 = Worksheets.Add(After:=Ws)
Ws1.Name = Xstr
DoEvents
ChangeFormulas Ws, Ystr, Xstr
Ws2.Delete

Application.DisplayAlerts = True

End Sub
Sub ChangeFormulas(Ws As Worksheet, Xstr As String, Ystr As String)
Dim Rng As Range, C As Range, FirstAddress As String
Set Rng = Ws.UsedRange
With Rng
    Set C = .Find(What:=Xstr, LookIn:=xlFormulas)
    If Not C Is Nothing Then
        FirstAddress = C.Address
        Do
            C.Formula = Replace(C.Formula, Xstr, Ystr)
            Set C = .FindNext(C)
            If C Is Nothing Then Exit Do
            If C.Address = FirstAddress Then Exit Do
        Loop
    End If
End With

End Sub

Another simplest workaround is not to delete the Sheet at all and import the CSV and copy the full sheet onto the sheet in question. However This fully depends on actual working conditions involving CSV and all.

Answer 3

My original answer did not work for non-contiguous cells. However, I really like the Range to Variants and then back to Range pattern. Very fast. So I rewrote my original answer into more reusable code that tests using non-contiguous cells.

Function PreserveFormulaeInVariantArr(ByVal aWorksheet As Worksheet, _
                                      ByVal aIsNoFormulaErr As Boolean, _
                                      ByRef aErrStr As String) As Variant
  Dim TmpRange As Range
  Dim TmpAreaCnt As Long
  Dim TmpVarArr As Variant
  Dim TmpAreaVarArr As Variant

  PreserveFormulaeInVariantArr = Empty

  If aWorksheet Is Nothing Then
    aErrStr = "PreserveFormulaeInVariantArr: Worksheet is Nothing."
    Exit Function
  End If

  Err.Clear
  On Error Resume Next
  Set TmpRange = aWorksheet.Cells.SpecialCells(xlCellTypeFormulas)
  If Err.Number <> 0 Then 'No Formulae.
    PreserveFormulaeInVariantArr = Empty
    If aIsNoFormulaErr Then
      aErrStr = "PreserveFormulaeInVariantArr: No cells with formulae."
    End If
    Exit Function
  End If

  TmpAreaVarArr = Empty
  On Error GoTo ErrLabel
  ReDim TmpVarArr(1 To TmpRange.Areas.Count, 1 To 2)

  For TmpAreaCnt = LBound(TmpVarArr) To UBound(TmpVarArr)
    TmpVarArr(TmpAreaCnt, 1) = TmpRange.Areas(TmpAreaCnt).Address 'Set 1st Element to Range
    TmpAreaVarArr = TmpRange.Areas(TmpAreaCnt).Formula 'Left TmpArrVarArr for Debugging
    TmpVarArr(TmpAreaCnt, 2) = TmpAreaVarArr 'Creates Jagged Array
  Next TmpAreaCnt

  PreserveFormulaeInVariantArr = TmpVarArr

  Exit Function
ErrLabel:
  aErrStr = "PreserveFormulaeInVariantArr - Error Number: " + CStr(Err.Number) + " Error Description: " + Err.Description
End Function

Function RestoreFormulaeFromVariantArr(ByVal aWorksheet As Worksheet, _
                                       ByVal aIsEmptyAreaVarArrError As Boolean, _
                                       ByVal aAreaVarArr As Variant, _
                                       ByRef aErrStr As String) As Boolean
  Dim TmpVarArrCnt As Long
  Dim TmpRange As Range
  Dim TmpDim1Var As Variant
  Dim TmpDim2Var As Variant
  Dim TmpDim2Cnt As Long
  Dim TmpDim2UBound As Long

  RestoreFormulaeFromVariantArr = False

  On Error GoTo ErrLabel

  If aWorksheet Is Nothing Then
    Exit Function
  End If

  If IsEmpty(aAreaVarArr) Then
    If aIsEmptyAreaVarArrError Then
      aErrStr = "RestoreFormulaeFromVariantArr: Empty array passed."
    Else
      RestoreFormulaeFromVariantArr = True
    End If
    Exit Function
  End If

  For TmpVarArrCnt = 1 To UBound(aAreaVarArr)
    TmpDim1Var = aAreaVarArr(TmpVarArrCnt, 1) 'This is always the range.
    TmpDim2Var = aAreaVarArr(TmpVarArrCnt, 2) 'This can be a Variant or Variant Array
    aWorksheet.Range(TmpDim1Var).Formula = TmpDim2Var
  Next TmpVarArrCnt

  RestoreFormulaeFromVariantArr = True

  Exit Function
ErrLabel:
  aErrStr = "PreserveFormulaeInVariantArr - Error Number: " + CStr(Err.Number) + " Error Description: " + Err.Description
End Function

Sub TestPreserveFormulaeInVariantArr()
  Dim TmpPreserveFormulaeArr As Variant
  Dim TmpErrStr As String
  Dim TmpIsNoFormulaErr As Boolean: TmpIsNoFormulaErr = True 'Change If Desired
  Dim TmpEmptySheet1 As Boolean: TmpEmptySheet1 = False 'Change If Desired
  Dim TmpSheet1 As Worksheet: Set TmpSheet1 = Sheets("Sheet1")
  Dim TmpSheet2 As Worksheet

  Err.Clear
  On Error Resume Next
  Set TmpSheet2 = Sheets("Sheet2")
  On Error GoTo 0

  'Always Delete Sheet2
  If (TmpSheet2 Is Nothing) = False Then
    Application.DisplayAlerts = False
    TmpSheet2.Delete
    Application.DisplayAlerts = True
    Set TmpSheet2 = Nothing
  End If

  If TmpSheet2 Is Nothing Then
    Set TmpSheet2 = Worksheets.Add(After:=Sheets("Sheet1"))
    TmpSheet2.Name = "Sheet2"
    TmpSheet2.Range("A1") = "Sheet2A1"
    TmpSheet2.Range("B1") = "Sheet2A1"
    TmpSheet2.Range("C4") = "Sheet2C4"

    If TmpEmptySheet1 Then
      TmpSheet1.Cells.ClearContents
    Else
      TmpSheet1.Range("A1").Formula = "=Sheet2!A1"
      TmpSheet1.Range("B1").Formula = "=Sheet2!B1"
      TmpSheet1.Range("C4").Formula = "=Sheet2!C4"
    End If
  End If

  TmpPreserveFormulaeArr = PreserveFormulaeInVariantArr(TmpSheet1, TmpIsNoFormulaErr, TmpErrStr)

  If TmpErrStr <> "" Then
    MsgBox TmpErrStr
    Exit Sub
  End If

  'Break Formulae and Cause #Ref Violation
  Application.DisplayAlerts = False
  TmpSheet2.Delete
  Application.DisplayAlerts = True

  'Add Sheet2 Back
  Set TmpSheet2 = Worksheets.Add(After:=Sheets("Sheet1"))
  TmpSheet2.Name = "Sheet2"
  TmpSheet2.Range("A1") = "Sheet2A1"
  TmpSheet2.Range("B1") = "Sheet2A1"
  TmpSheet2.Range("C4") = "Sheet2C4"

  'Restore Formulas Back to Sheet1
  If RestoreFormulaeFromVariantArr(TmpSheet1, TmpIsNoFormulaErr, TmpPreserveFormulaeArr, TmpErrStr) = False Then
    MsgBox TmpErrStr
    Exit Sub
  End If
End Sub

The TestPreserveFormulaeInVariantArr can be run in the VBE with options to set empty values. Any comments appreciated.