The new table feature on Excel is excellent and you can specify a column formula as well as exceptions on the column. However, if you want to change the column formula, Excel will rewrite the whole column including the exceptions. I've tried to avoid this issue with the following code:
Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo ErrHandler 'Prevent from firing if changed cell is outside a table If Target.ListObject Is Nothing Then Exit Sub 'Prevent from firing if cell is changed to a value If Val(Target.Formula) = Target.Value Then Exit Sub 'Prevent from firing if multiple cells where changed If Target.Count > 1 Then Exit Sub 'Disable events ToggleWaitMode 'Prevent change if user already stated calculation as manual Dim bCheckCalculationMode As Boolean If Application.Calculation = xlCalculationAutomatic Then Application.Calculation = xlCalculationManual bCheckCalculationMode = True End If 'Declarations Dim sTableName As String Dim lNbLines As Long Dim i As Long Dim sFieldName As String Dim cel As Range Dim sOldFormula As String Dim sNewFormula As String Dim aExceptionFormulas() As String Dim aExceptionAddresses() As String sTableName = Target.ListObject.Name lNbLines = Range(sTableName).Rows.Count sFieldName = "[" & Intersect(Target.ListObject.HeaderRowRange, Target.EntireColumn).Value & "]" 'Add a new row to get the column formula Range(sTableName).ListObject.ListRows.Add sOldFormula = Range(sTableName & sFieldName)(lNbLines).Formula sNewFormula = Target.Formula 'Loop on each cell of the column to get each exception formulas and addresses in arrays i = 1 For Each cel In Range(sTableName & sFieldName) If cel.Formula <> sOldFormula Then ReDim Preserve aExceptionFormulas(1 To i) ReDim Preserve aExceptionAddresses(1 To i) aExceptionFormulas(i) = cel.Formula aExceptionAddresses(i) = cel.Address i = i + 1 End If Next cel 'Delete added row and replace column to new formula Range(sTableName).ListObject.ListRows(lNbLines).Delete Range(sTableName & sFieldName).Formula = sNewFormula If i > 1 Then For i = 1 To UBound(aExceptionFormulas) Range(aExceptionAddresses(i)).Formula = aExceptionFormulas(i) Next i End If ActiveSheet.Calculate CleanExit: If bCheckCalculationMode Then Application.Calculation = xlCalculationAutomatic ToggleWaitMode False Exit Sub ErrHandler: End Sub Private Sub ToggleWaitMode(Optional ByVal bWait As Boolean = True) Application.EnableEvents = Not bWait Application.AutoCorrect.AutoFillFormulasInLists = Not bWait End Sub
The code works but it's really ugly. Do you think it's possible to optimize it? For example by finding the Inconsistent Formulas?
Edit: I've modified the code accordingly to the great advices of Mat's Mug. I hope it got better. Can the added row be avoided? It's just a workaround to get the column formula.