Switches table references in cells in range based on first table reference in each cell

PHOTO EMBED

Wed Sep 08 2021 06:02:00 GMT+0000 (UTC)

Saved by @Darkleech #vba

Sub swapTableReferences(formulaRange As Range)
'Switches table references in cells in range based on first table reference in each cell, ie:
    'If first table reference in a cell is relative, references are changed to fixed
    'If first table reference in a cell is fixed, references are changed to relative
    
    Dim c As Range
    Dim fText As String
    Dim tempText As String
    Dim colName As String
    Dim startStr As String
    Dim startBracket As Long
    Dim endBracket As Long
    Dim screenUp As Boolean
    
    screenUp = Application.ScreenUpdating
    
    If screenUp Then
        Application.ScreenUpdating = False
    End If
    
    For Each c In formulaRange
        fText = c.Formula
        tempText = ""
        goAhead = False
        If Mid(fText, InStr(fText, "]") + 1, 1) = ":" Then
            invert = True
        Else
            invert = False
        End If
        Do Until goAhead = True
            startBracket = InStr(fText, "[")
            endBracket = InStr(fText, "]")
            If startBracket = 0 Or endBracket = 0 Or endBracket < startBracket Then
                tempText = tempText & fText
                goAhead = True
            ElseIf Mid(fText, startBracket + 1, 1) = "[" Or Mid(fText, endBracket + 1, 1) = ":" Then
                If invert = False Or Mid(fText, startBracket + 2, 1) = "#" Then
                    endBracket = InStr(endBracket + 1, fText, "]")
                    tempText = tempText & Left(fText, endBracket + 1)
                    fText = Right(fText, Len(fText) - endBracket - 1)
                Else
                    If Mid(fText, endBracket + 1, 1) = ":" Then
                        colName = Mid(fText, startBracket + 3, endBracket - startBracket - 3)
                        tempText = tempText & Left(fText, startBracket - 1) & "[@[" & colName & "]]"
                    Else
                        colName = Mid(fText, startBracket + 2, endBracket - startBracket - 2)
                        tempText = tempText & Left(fText, startBracket - 1) & "[" & colName & "]"
                    End If
                    fText = Right(fText, Len(fText) - InStr(endBracket + 1, fText, "]") - 1)
                End If
            ElseIf invert = False Then
                If Mid(fText, startBracket + 1, 1) = "@" Then
                    If Mid(fText, startBracket + 2, 1) = "[" Then
                        endBracket = endBracket + 1
                        colName = Mid(fText, startBracket + 3, endBracket - startBracket - 4)
                    Else
                        colName = Mid(fText, startBracket + 2, endBracket - startBracket - 2)
                    End If
                    startStr = "[@["
                Else
                    colName = Mid(fText, startBracket + 1, endBracket - startBracket - 1)
                    startStr = "[["
                End If
                tempText = tempText & Left(fText, startBracket - 1) & startStr & colName & "]:[" & colName & "]]"
                fText = Right(fText, Len(fText) - endBracket)
            ElseIf (Mid(fText, startBracket + 1, 1) = "@") And (Mid(fText, startBracket + 2, 1) = "[") Then
                If Mid(fText, endBracket + 1, 1) = "]" Then
                    tempText = tempText & Left(fText, endBracket + 1)
                    fText = Right(fText, Len(fText) - endBracket - 1)
                Else
                    colName = Mid(fText, startBracket + 3, endBracket - startBracket - 3)
                    tempText = tempText & Left(fText, startBracket - 1) & "[@[" & colName & "]]"
                    fText = Right(fText, Len(fText) - InStr(endBracket + 1, fText, "]") - 1)
                End If
            Else
                tempText = tempText & Left(fText, endBracket)
                fText = Right(fText, Len(fText) - endBracket)
            End If
        Loop
        If Not tempText = fText Then
            c.Formula = tempText
        End If
    Next
    
    If screenUp Then
        Application.ScreenUpdating = True
    End If
        
End Sub
content_copyCOPY