Improve VBA flexibility to convert VLOOKUP to INDEX/MATCH

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, ie 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 ;)