Function ReplaceSubstring(SourceStr As Variant, FromList As Variant, ToList As Variant) As Variant
%REM
Replaces specific words or phrases in a string with new words or phrases that you spcify.
This function is case sensitive
First parameter is the string whose contents you want to modify
The second parameter is either text or text list -- a list containing the words or phrases that you want to replace
The third parameter is either text or text list -- a list containing the replacement words or phrases
%END REM
Dim Position As Long
Dim NewString As String
Dim FromListArr() As String
Dim ToListArr() As String
Dim i As Long
Dim j As Long
%REM
If more array elements are specified in the FromList than the ToList, the extra elements
in FromList are replaced with the last string in ToList. If extra elements are in ToList
then the extra elements are ignored. If a list is specified for FromList, each
subsequent list item is scanned against the resulting SourceStr, with prior list item
substitutions performed. For example, if "A black cat" is the SourceStr and FromList is
a list containing "cat" and "dog", and ToList is a list containing "dog" and "mouse", then
the first iteration will replace "cat" (1st element in FromList) with "dog" (1st element
in ToList) and SourceStr will be "A black dog". The second iteration will replace "dog"
(2nd element in FromList) with "mouse" (2nd element in ToList) and the function will
return "A black mouse". This is exactly how @ReplaceSubstring works.
If SourceStr is actually an array of strings, then the same logic will be placed on every
element of that array.
%END REM
%REM
There are 4 possibilities:
(1) FromList and ToList are both arrays. If the number in elements in FromList is less than
the number of elements in ToList, ignore the rest of ToList. If number of elements in
FromList is greater than the number of elements in ToList, pad ToList with the last element
in FromList. If the number of elements is the same, everything's fine.
(2) FromList is an array and ToList is a single element. Build a temporary array for ToList
where each element is identical (what was passed) and the number of elements is the same as
the number of elements in FromList.
(3) FromList is a single element and ToList is an array. The extra elements in ToList will
be ignored, so we just care about the first element in ToList.
(4) FromList and ToList are single elements. Build a temporary array for each of them where
there is only 1 element in the array (what was passed).
%END REM
If Isarray(FromList) And Isarray(ToList) Then ' Case (1) above
' We only care about the number of elements in FromList - if there are
' extra elements in ToList, the extra ones are ignored.
Redim FromListArr(Ubound(FromList))
Redim ToListArr(Ubound(FromList))
If Ubound(FromList) < Ubound(ToList) Then
For i = Lbound(ToList) To Ubound(ToList)
FromListArr(i) = FromList(i)
ToListArr(i) = ToList(i)
Next
' Now pad the ToList array with the last element of ToList
For i = Ubound(ToList)+1 To Ubound(FromList)
FromListArr(i) = FromList(i)
ToListArr(i) = ToList(Ubound(ToList))
Next
Else ' Identical number of elements in each array
For i = Lbound(FromList) To Ubound(FromList)
FromListArr(i) = FromList(i)
ToListArr(i) = ToList(i)
Next
End If
End If
If Isarray(FromList) And Not Isarray(ToList) Then ' Case (2) above
Redim FromListArr(Ubound(FromList))
Redim ToListArr(Ubound(FromList))
For i = Lbound(FromList) To Ubound(FromList)
FromListArr(i) = FromList(i)
ToListArr(i) = ToList
Next
End If
If Not Isarray(FromList) And Isarray(ToList) Then ' Case (3) above
Redim FromListArr(0)
Redim ToListArr(0)
FromListArr(0) = FromList
ToListArr(0) = ToList(0)
End If
If Not Isarray(FromList) And Not Isarray(ToList) Then ' Case (4) above
Redim FromListArr(0)
Redim ToListArr(0)
FromListArr(0) = FromList
ToListArr(0) = ToList
End If
%REM
Now replace the elements. If SourceStr is a single string, just loop through all the
entries in FromListArr and replace it with the corresponding entry in ToListArr. If
SourceStr is an array, then do the same thing for each element of SourceStr.
%END REM
If Isarray(SourceStr) Then
For j = Lbound(SourceStr) To Ubound(SourceStr)
NewString = SourceStr(j)
For i = Lbound(FromListArr) To Ubound(FromListArr)
Call ReplaceIndSubstring(NewString, FromListArr(i), ToListArr(i))
Next
SourceStr(j) = NewString ' Put the new value back into the array
Next
ReplaceSubstring = SourceStr ' Return the variant array
Else ' SourceStr is a single element
NewString = SourceStr
For i = Lbound(FromListArr) To Ubound(FromListArr)
Call ReplaceIndSubstring(NewString, FromListArr(i), ToListArr(i))
Next
ReplaceSubstring = NewString ' Return the single string
End If
End Function
Function ReplaceIndSubstring(sourcestr As String, fromstr As String, tostr As String) As String
Dim convstr As String
Dim i As Long
Dim length As Long
tempstr = sourcestr
If Len(fromstr) = 0 Then
ReplaceIndSubstring = sourcestr
Exit Function
End If
If Instr(tostr, fromstr) <> 0 Then
i = 128
length = 1
convstr = ""
While convstr = ""
If Instr(tempstr, String$(length, Chr$(i))) = 0 Then convstr = String$(length, Chr$(i))
i = i + 1
If i = 256 Then
i = 128
End If
Wend
While Instr(tempstr, fromstr) <> 0
tempstr = Left(tempstr, Instr(tempstr, fromstr)-1) & convstr _
& Mid(tempstr, Instr(tempstr, fromstr)+Len(fromstr))
Wend
While Instr(tempstr, convstr) <> 0
tempstr = Left(tempstr, Instr(tempstr, convstr)-1) & tostr _
& Mid(tempstr, Instr(tempstr, convstr)+Len(convstr))
Wend
Else
While Instr(tempstr, fromstr) <> 0
tempstr = Left(tempstr, Instr(tempstr, fromstr)-1) & tostr _
& Mid(tempstr, Instr(tempstr, fromstr)+Len(fromstr))
Wend
End If
ReplaceIndSubstring = tempstr
End Function