Update for ND6.... Since ND6 allows strings the size of 2 GB, this function needs to be updated - the position within a string can be longer than an Integer variable can handle. So Integer has been changed to Long in the function.
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