Improve VBA flexibility to convert VLOOKUP to INDEX/MATCH - vba

Question

After all my searching for code to read in a VLOOKUP formula and converting it to INDEX/MATCH came up empty, I wrote some myself.
However, the code (below) is lacking some of the flexibility I would like, but I can't seem to figure out how to make it work. Specifically, I would like to test each range criterion in the VLOOKUP formula for being an absolute reference or not, i.e. preceded by $, and carry that through to the INDEX/MATCH formula that results. For example, the formula =VLOOKUP(A2,$A$1:B$11,2,FALSE) should convert to =INDEX(B$1:B$11,MATCH(A2,$A1:$A11,0)).
NOTE: This sub depends on two functions (ColumnLetterToNumber and ColumnNumberToLetter). As their names imply they take column letters or numbers and interconvert them. Both these functions are short, simple, and work without problems. However, if anyone believes that the code to one or both of them would be helpful, I would be happy to provide them.
Additionally, any ideas on improving code readability and/or execution efficiency would also be appreciated.
Option Explicit
Public Sub ConvertToIndex()
Dim booLookupType As Boolean
Dim booLeftOfColon As Boolean
Dim booHasRowRef As Boolean
Dim lngStartCol As Long
Dim lngRefCol As Long
Dim lngStart As Long
Dim lngEnd As Long
Dim lngMatchType As Long
Dim lngInt As Long
Dim lngRowRef As Long
Dim strRefCol As String
Dim strOldFormula As String
Dim strNewFormula As String
Dim strLookupCell As String
Dim strValueCol As String
Dim strMatchCol As String
Dim strStartRow As String
Dim strEndRow As String
Dim strCheck As String
Dim strLookupRange As String
Dim strTabRef As String
Dim strSheetRef As String
Dim rngToMod As Range
Dim rngModCell As Range
Set rngToMod = Selection
For Each rngModCell In rngToMod
strOldFormula = rngModCell.Formula
lngStart = InStrRev(strOldFormula, "VLOOKUP(")
If lngStart > 0 Then
lngStart = InStr(lngStart, strOldFormula, "(") + 1
lngEnd = InStr(lngStart, strOldFormula, ",")
strLookupCell = Mid(strOldFormula, lngStart, lngEnd - lngStart)
lngStart = lngEnd + 1
lngEnd = InStr(lngStart, strOldFormula, ",")
strLookupRange = Mid(strOldFormula, lngStart, lngEnd - lngStart)
lngStart = lngEnd + 1
lngEnd = InStr(lngStart, strOldFormula, ",")
lngRefCol = CInt(Mid(strOldFormula, lngStart, lngEnd - lngStart))
lngStart = lngEnd + 1
lngEnd = InStr(lngStart, strOldFormula, ")")
booLookupType = (Mid(strOldFormula, lngStart, lngEnd - lngStart) = "TRUE")
If booLookupType Then
lngMatchType = 1
Else
lngMatchType = 0
End If
booLeftOfColon = True
lngEnd = InStr(1, strLookupRange, "]")
If lngEnd > 0 Then
strSheetRef = Left(strLookupRange, lngEnd)
strLookupRange = Right(strLookupRange, Len(strLookupRange) - lngEnd)
Else
strSheetRef = ""
End If
lngEnd = InStr(1, strLookupRange, "!")
If lngEnd > 0 Then
strTabRef = Left(strLookupRange, lngEnd)
strLookupRange = Right(strLookupRange, Len(strLookupRange) - lngEnd)
Else
strTabRef = ""
End If
For lngInt = 1 To Len(strLookupRange)
strCheck = Mid(strLookupRange, lngInt, 1)
Select Case True
Case strCheck = ":"
booLeftOfColon = False
Case booLeftOfColon
If IsNumeric(strCheck) Then
strStartRow = strStartRow & strCheck
Else
strMatchCol = strMatchCol & strCheck
End If
Case Else
If IsNumeric(strCheck) Then strEndRow = strEndRow & strCheck
End Select
Next lngInt
strMatchCol = Replace(strMatchCol, "$", "")
lngStartCol = ColumnLetterToNumber(strMatchCol)
strValueCol = ColumnNumberToLetter(lngStartCol + lngRefCol - 1)
If Len(strStartRow) > 0 Then strStartRow = "$" & strStartRow
If Len(strEndRow) > 0 Then strEndRow = "$" & strEndRow
strValueCol = strSheetRef & strTabRef & strValueCol & strStartRow & ":" & strValueCol & strEndRow
strMatchCol = strSheetRef & strTabRef & strMatchCol & strStartRow & ":" & strMatchCol & strEndRow
strNewFormula = "=INDEX(" & strValueCol & ",MATCH(" & "$" & strLookupCell & "," & strMatchCol & "," & lngMatchType & "))"
rngModCell.Formula = strNewFormula
End If
Next rngModCell
End Sub
At this time I am not looking for help to take this to the next step of enabling it to process VLOOKUP/HLOOKUP or VLOOKUP/MATCH combination formulas.

Answer 1

To avoid all errors I can think of, you would need to change it to a not so good looking way like this:
Sub changeToIndex()
Dim xText As Boolean
Dim xBrac As Long
Dim VLSep As New Collection
Dim i As Long, t As String
With Selection.Cells(1, 1) 'just for now
'it assumes that there is NEVER a text string which has VLOOKUP like =A1&"mean text with VLOOKUP inside it"
While InStr(1, .Formula, "VLOOKUP", vbTextCompare)
Set VLSep = New Collection
VLSep.Add " " & InStr(1, .Formula, "VLOOKUP", vbTextCompare) + 7
'get the parts
For i = VLSep(1) + 1 To Len(.Formula)
t = Mid(.Formula, i, 1)
If t = """" Then
xText = Not xText
ElseIf Not xText Then 'avoid "(", ")" and "," inside of the string to be count
If t = "(" Then
xBrac = xBrac + 1
ElseIf xBrac Then 'cover up if inside of other functions
If t = ")" Then xBrac = xBrac - 1
ElseIf t = ")" Then
VLSep.Add " " & i
Exit For
ElseIf t = "," Then
VLSep.Add " " & i 'the space is to avoid errors with index and item if both are numbers
End If
End If
Next
Dim xFind As String 'get all the parts
Dim xRng As String
Dim xCol As String
Dim xType As String
xFind = Mid(.Formula, VLSep(1) + 1, VLSep(2) - VLSep(1) - 1)
xRng = Mid(.Formula, VLSep(2) + 1, VLSep(3) - VLSep(2) - 1)
xCol = Mid(.Formula, VLSep(3) + 1, VLSep(4) - VLSep(3) - 1)
If VLSep.Count = 5 Then
xType = Mid(.Formula, VLSep(4) + 1, VLSep(5) - VLSep(4) - 1)
Else
xType = "0"
End If
Dim fullFormulaNew As String 'get the whole formulas
Dim fullFormulaOld As String
fullFormulaNew = "INDEX(" & xRng & ",MATCH(" & xFind & ",INDEX(" & xRng & ",,1)," & xType & ")," & xCol & ")"
fullFormulaOld = Mid(Selection.Cells(1, 1).Formula, VLSep(1) - 7, VLSep(VLSep.Count) - VLSep(1) + 8)
.Formula = Replace(.Formula, fullFormulaOld, fullFormulaNew) 'simply replace the old one with the new one
Wend
End With
End Sub
It also should work for very complex formulas. Still you would need some special checks to cut everything so it looks like you want. I just assumed that the range for the vlookup may be something like IF(A1=1,B1:C10,L5:N30) and this said, you would need additional subs to also clear something like this up. :(
A formula like
=VLOOKUP(VLOOKUP(IF(TRUE,A2,"aaa"),$A$1:B$11,2),$B$1:$C$11,2,FALSE)
will be changed (messed up) this way to
=INDEX($B$1:$C$11,MATCH(INDEX($A$1:B$11,MATCH(IF(TRUE,A2,"aaa"),INDEX($A$1:B$11,,1),0),2),INDEX($B$1:$C$11,,1),FALSE),2)
EDIT
Assuming your formulas are "normal" you can replace the the last part with:
Dim xFind As String 'get all the parts
Dim xRngI As String, xRngM As String
Dim xCol As String
Dim xType As String
xFind = Mid(.Formula, VLSep(1) + 1, VLSep(2) - VLSep(1) - 1)
xRngI = Mid(.Formula, VLSep(2) + 1, VLSep(3) - VLSep(2) - 1)
xCol = Mid(.Formula, VLSep(3) + 1, VLSep(4) - VLSep(3) - 1)
If VLSep.Count = 5 Then
xType = Mid(.Formula, VLSep(4) + 1, VLSep(5) - VLSep(4) - 1)
Else
xType = "0"
End If
If xType = "FALSE" Then xType = 0
Do While Not IsNumeric(xCol)
Select Case MsgBox("Error: The Column to pick from is not numerical! Do you want to manually set the column (Yes) or directly use the last column of the input range (No)?", vbYesNoCancel)
Case vbYes
xCol = Application.InputBox("Input the column number for the input range (" & xRngI & "). '1' will be the range " & Range(xRngI).Columns(1).Address(0, 0) & ".", "Column to pick from", 1, , , , , 2)
Case vbNo
xCol = Range(xRngI).Columns.Count
Case vbCancel
xCol = " "
Exit Do
End Select
If xCol <> CInt(xCol) Or xCol > Range(xRngI).Columns.Count Or xCol = 0 Then xCol = " "
Loop
If IsNumeric(xCol) Then
Dim absRs As Boolean, absRe As Boolean, absCs As Boolean, absCe As Boolean
absCs = (Left(xRngI, 1) = "$")
absCe = (Mid(xRngI, InStr(xRngI, ":") + 1, 1) = "$")
absRs = (InStr(2, Left(xRngI, InStr(xRngI, ":") - 1), "$") > 0)
absRe = (InStr(Mid(xRngI, InStr(xRngI, ":") + 2), "$") > 0)
xRngM = Range(xRngI).Columns(1).Cells(1, 1).Address(absRs, absCs) & ":" & Range(xRngI).Columns(1).Cells(Range(xRngI).Rows.Count, 1).Address(absRe, absCs) 'for MATCH
xRngI = Range(xRngI).Cells(1, CLng(xCol)).Address(absRs, absCe) & ":" & Range(xRngI).Cells(Range(xRngI).Rows.Count, CLng(xCol)).Address(absRe, absCe) 'for INDEX
Dim fullFormulaNew As String, fullFormulaOld As String
fullFormulaNew = "INDEX(" & xRngI & ",MATCH(" & xFind & "," & xRngM & "," & xType & "))"
fullFormulaOld = Mid(Selection.Cells(1, 1).Formula, VLSep(1) - 7, VLSep(VLSep.Count) - VLSep(1) + 8)
.Formula = Replace(.Formula, fullFormulaOld, fullFormulaNew) 'simply replace the old one with the new one
End If
Wend
End With
End Sub
As you can see: the "simpler" the outcome, the more code you need. If the lookup_range is not just a address, this will fail.
If you still have any questions, just ask ;)