Switches table references in cells in range based on first table reference in each cell
Wed Sep 08 2021 06:02:00 GMT+0000 (Coordinated Universal Time)
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
Comments