REPLACE VALUES WITH WEIGHTED LETTERS FROM TABLE

Function MSUBSTITUTE(text As Variant, old_text As Variant, new_text As Variant) As Variant
    'Version 2.  Aug 12/2002
    Dim vNew As Variant
    Dim vOld As Variant
    Dim vText As Variant
    Dim iRow As Long
    Dim iCol As Integer
    Dim j As Integer
    
    If IsArray(old_text) Then
    vOld = old_text
    vNew = new_text
    
    If UBound(vOld, 1) > 1 And UBound(vOld, 2) > 1 Then
    'Must be a 1D array
    MSUBSTITUTE = CVErr(xlErrNum)
    Exit Function
    End If
    
    If IsArray(vNew) Then
    If UBound(vOld, 1)<> UBound(vNew, 1) Or UBound(vOld, 2)<> UBound(vNew, 2) Then
    'Different arrays, can't do this
    MSUBSTITUTE = CVErr(xlErrNum)
    Exit Function
    End If
    End If
    
    'Is column, transpose to row
    If UBound(vOld, 2) > 1 Then
    vOld = Application.Transpose(vOld)
    End If
    
    If IsArray(vNew) Then
    If UBound(vNew, 2) > 1 Then
    vNew = Application.Transpose(vNew)
    End If
    
    ReDim Preserve vNew(1 To UBound(vOld, 1), 1 To 1)
    Else
    ReDim vNew(1 To UBound(vOld, 1), 1 To 1)
    For iRow = 1 To UBound(vOld, 1)
    vNew(iRow, 1) = new_text
    Next iRow
    End If
    
    Else
    ReDim vOld(1 To Len(old_text), 1 To 1)
    ReDim vNew(1 To Len(old_text), 1 To 1)
    
    For iRow = 1 To Len(old_text)
    vOld(iRow, 1) = Mid(old_text, iRow, 1)
    If Mid(new_text, iRow, 1)<> "" Then
    vNew(iRow, 1) = Mid(new_text, iRow, 1)
    Else
    vNew(iRow, 1) = ""
    End If
    Next iRow
    
    End If
    If IsArray(text) Then
    vText = text
    For iRow = LBound(vText, 1) To UBound(vText, 1)
    For iCol = LBound(vText, 2) To UBound(vText, 2)
    For j = 1 To UBound(vOld, 1)
    vText(iRow, iCol) = Application.Substitute(vText(iRow, iCol), vOld(j, 1), vNew(j, 1))
    Next j
    Next iCol
    Next iRow
    Else
    vText = text
    For j = 1 To UBound(vOld, 1)
    vText = Application.Substitute(vText, vOld(j, 1), vNew(j, 1))
    Next j
    End If
    MSUBSTITUTE = vText
End Function