Option Explicit 
Option Base 0 
 'Code Written by Aaron Bush - 05/04/2007
 'Free for Public Use
#If Not VB6 Then 
    Public Const vbBinaryCompare As Long = 0 
    Public Const vbTextCompare As Long = 1 
    Public Function Replace(Expression As Variant, Find As Variant, ReplaceWith As Variant, Optional Start As Long = 1, Optional Count As Long = -1, Optional Compare As Long) 
        Dim byExpression() As Byte 'Byte Array holding "Expression" argument.
        Dim byFind() As Byte 'Byte Array holding "Find" argument.
        Dim byRplcW() As Byte 'Byte Array holding "ReplaceWith" argument.
        Dim byTmp() As Byte 'Byte Array holding return value until completion.
         'Array Indexes:
        Dim lExpPos As Long 
        Dim lFindPos As Long 
        Dim lRplcPos As Long 
        Dim lTmpPos As Long 
         'Array Lower Bounds:
        Dim lExprLB As Long 
         'All others use 0
         'Array Upper-Bounds:
        Dim lExprUB As Long 
        Dim lFindUB As Long 
        Dim lRplcUB As Long 
        Dim lTmpUB As Long 
         'String Versions of Arguments:
        Dim sExpr As String 
        Dim sFind As String 
         'Counter(s):
        Dim lRplcCnt As Long 'Counts the number of replacments made.
        Const lNoReplace_c As Long = -1 
        Const lZero_c As Long = 0 
        Const lArrayOffset_c As Long = 1 
        Const lUnicodeOffset_c As Long = 2 
        If Count = lZero_c Then Exit Function 
        If Compare = vbBinaryCompare Then 
             'The comparisons this function makes are of ASCII values,
             'so no action is needed to make a binary comparison.
            byExpression = CStr(Expression) 
            byFind = CStr(Find) 
        Else 
             'As a Q&D way to do text comparison all values are converted
             'to lower case for comparison:
            sExpr = VBA.LCase$(CStr(Expression)) 
            sFind = VBA.LCase$(CStr(Find)) 
            byExpression = sExpr 
            byFind = sFind 
        End If 
        If UBound(byFind) < lZero_c Then 
            Replace = CStr(byExpression) 
            Exit Function 
        End If 
         'Set UpperBounds to variables as all are used in several places.
        lExprUB = UBound(byExpression) 
        If Start > lExprUB + lArrayOffset_c Then Exit Function 
        lFindUB = UBound(byFind) 
        byRplcW = CStr(ReplaceWith) 
        lRplcUB = UBound(byRplcW) 
        lExprLB = Start - lArrayOffset_c 
        Do 
            For lExpPos = lExprLB To lExprUB Step lUnicodeOffset_c 
                If byExpression(lExpPos) = byFind(lFindPos) Then 
                    lFindPos = lFindPos + lUnicodeOffset_c 
                    If lFindPos > lFindUB Then 
                        lFindPos = lZero_c 
                        Exit For 
                    End If 
                Else 
                    lFindPos = lZero_c 
                End If 
            Next lExpPos 
             'Check to see if entire string has been scanned:
            If lExpPos > lExprUB Then 
                Exit Do 
            Else 
                 'Do replacement:
                If Compare = vbTextCompare Then 
                     'Restore Case:
                    byExpression = sExpr 
                    byFind = sFind 
                End If 
                 'Set lowerbound for next replacement:
                lExprLB = lExpPos - lFindUB + lRplcUB 
                 'Create Temp array for to hold replaced value while it
                 'is being built.
                lTmpUB = lExprUB - lFindUB + lRplcUB 
                ReDim byTmp(lTmpUB) As Byte 
                 'Load text before Found-text:
                For lTmpPos = lZero_c To lExpPos - lFindUB Step lUnicodeOffset_c 
                    byTmp(lTmpPos) = byExpression(lTmpPos) 
                Next lTmpPos 
                 'Load replacement text:
                lRplcPos = lZero_c 
                For lTmpPos = lTmpPos To lTmpPos + lRplcUB Step lUnicodeOffset_c 
                    byTmp(lTmpPos) = byRplcW(lRplcPos) 
                    lRplcPos = lRplcPos + lUnicodeOffset_c 
                Next lTmpPos 
                 'Load text after Found-text:
                lExpPos = lExpPos + lUnicodeOffset_c 
                For lTmpPos = lTmpPos To lTmpUB Step lUnicodeOffset_c 
                    byTmp(lTmpPos) = byExpression(lExpPos) 
                    lExpPos = lExpPos + lUnicodeOffset_c 
                Next lTmpPos 
                 'Save replaced value:
                byExpression = byTmp 
                 'Prepare for next loop
                sExpr = CStr(byExpression) 
                lExprUB = UBound(byExpression) 
                If Count <> lNoReplace_c Then 
                    lRplcCnt = lRplcCnt + lArrayOffset_c 
                    If lRplcCnt = Start Then Exit Do 
                End If 
            End If 
        Loop 
        Replace = CStr(byExpression) 
    End Function 
#End If