Many Substitutes on single cell of text

[Blacksmith]

Hello all,

First poster and total excel novice here. I've recently been put in charge of a filing system at my workpace, and the software which was previously used was massively out of date and required lots of repetitive work from users. Over the past few weeks I've been iterating on an Excel-based replacement system that does a lot of the repetitive on its own, and learning how formulae work in the process.

One of the tasks I would like the system to do is automatically replace many abbreviations in a single cell of input text. A lot of the internal records at my workplace use extensive abbreviations, but when they need to be sent to insurance carriers, the insurance carriers demand all of the abbreviations be removed and re-written longform. What I've devised to fix this situation is a great many nested substitute commands, referencing a list of abbreviations and a list of their full texts in a separate sheet. The problem is, I used as many nested commands as Excel would allow, and I'm already very nearly approaching the maximum amount of abbreviations this system can handle as a result.

I would like to rework this system to substitute from a list of abbreviations of arbitrary length, not limited by the max number of nested commands. Is this possible? Maybe with a named range? All help or advice is appreciated.

(I have attached images showing examples of the nested substitute commands and some of the abbreviation list they reference)

 

[Blacksmith]

The format for the description cells is pretty standardized. It's always one sentence and the term "re:" (regarding) is always used after something that is being further explained.

 

[Peter_SSs]

OK, see if you could make use of something like this. My list of abbreviations and their replacements are in columns E:F but could easily be on another sheet.
Each abbreviation only needs to be listed once and the Replacement value should be capitalised in whatever way you would want that replacement if it was at the beginning of a sentence. So, although you said 're' would not be at the start, I have capitalised it 'just in case'.

Sub Replace_Abbreviations_v2()
  Dim RX As Object, Mtchs As Object
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  Dim s As String
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  b = Range("E2", Range("F" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    s = a(i, 1)
    For j = 1 To UBound(b)
      RX.Pattern = " ?\b" & b(j, 1) & "\b"
      Set Mtchs = RX.Execute(s)
      For k = Mtchs.Count To 1 Step -1
        s = Left(s, Mtchs(k - 1).firstindex) & IIf(Left(Mtchs(k - 1), 1) = " ", " " & LCase(b(j, 2)), b(j, 2)) & Mid(s, Mtchs(k - 1).firstindex + Mtchs(k - 1).Length + 1)
      Next k
    Next j
    a(i, 1) = s
  Next i
  Range("B2").Resize(UBound(a)).Value = a
End Sub

My sample data and results ..

Book1
	A	B	C	D	E	F
1	Data	Result			Abbrev	Replacement
2	OPC to repare report & send CT supervisor & CL re IC	Opposing counsel to repare report & send correspondence to supervisor & client re: insurance carrier			re	Re:
3	Attend DP of expert Dr. Steingart in Phoenix	Attend deposition of expert Dr. Steingart in Phoenix			IC	Insurance carrier
4	REV CT Bob	Review correspondence to Bob			PL	Plaintiff
5	CT Ann and REV CT Bob	Correspondence to Ann and review correspondence to Bob			CL	Client
6	Prepare for DP of expert Michael Steingart, D.O. (REV reports)	Prepare for deposition of expert Michael Steingart, D.O. (Review reports)			OPC	Opposing counsel
7					REV	Review
8					CT	Correspondence to
9					DP	Deposition
Sheet1 (v2)

 

[Blacksmith]

OK, see if you could make use of something like this. My list of abbreviations and their replacements are in columns E:F but could easily be on another sheet.
Each abbreviation only needs to be listed once and the Replacement value should be capitalised in whatever way you would want that replacement if it was at the beginning of a sentence. So, although you said 're' would not be at the start, I have capitalised it 'just in case'.

Sub Replace_Abbreviations_v2()
  Dim RX As Object, Mtchs As Object
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  Dim s As String

  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  b = Range("E2", Range("F" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    s = a(i, 1)
    For j = 1 To UBound(b)
      RX.Pattern = " ?\b" & b(j, 1) & "\b"
      Set Mtchs = RX.Execute(s)
      For k = Mtchs.Count To 1 Step -1
        s = Left(s, Mtchs(k - 1).firstindex) & IIf(Left(Mtchs(k - 1), 1) = " ", " " & LCase(b(j, 2)), b(j, 2)) & Mid(s, Mtchs(k - 1).firstindex + Mtchs(k - 1).Length + 1)
      Next k
    Next j
    a(i, 1) = s
  Next i
  Range("B2").Resize(UBound(a)).Value = a
End Sub

My sample data and results ..

Book1
	A	B	C	D	E	F
1	Data	Result			Abbrev	Replacement
2	OPC to repare report & send CT supervisor & CL re IC	Opposing counsel to repare report & send correspondence to supervisor & client re: insurance carrier			re	Re:
3	Attend DP of expert Dr. Steingart in Phoenix	Attend deposition of expert Dr. Steingart in Phoenix			IC	Insurance carrier
4	REV CT Bob	Review correspondence to Bob			PL	Plaintiff
5	CT Ann and REV CT Bob	Correspondence to Ann and review correspondence to Bob			CL	Client
6	Prepare for DP of expert Michael Steingart, D.O. (REV reports)	Prepare for deposition of expert Michael Steingart, D.O. (Review reports)			OPC	Opposing counsel
7					REV	Review
8					CT	Correspondence to
9					DP	Deposition
Sheet1 (v2)

I took your code and modified it to use the pre-existing list of abbreviations:

Sub Replace_Abbreviations_v2()
  Dim RX As Object, Mtchs As Object
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  Dim s As String
 
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  a = Sheet1.Range("B2", Sheet1.Range("B" & Rows.Count).End(xlUp)).Value
  b = Sheet6.Range("E2", Sheet6.Range("F" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    s = a(i, 1)
    For j = 1 To UBound(b)
      RX.Pattern = " ?\b" & b(j, 1) & "\b"
      Set Mtchs = RX.Execute(s)
      For k = Mtchs.Count To 1 Step -1
        s = Left(s, Mtchs(k - 1).firstindex) & IIf(Left(Mtchs(k - 1), 1) = " ", " " & LCase(b(j, 2)), b(j, 2)) & Mid(s, Mtchs(k - 1).firstindex + Mtchs(k - 1).Length + 1)
      Next k
    Next j
    a(i, 1) = s
  Next i
  Sheet1.Range("B2").Resize(UBound(a)).Value = a
End Sub

It's working well for the most part, but some of the abbreviations don't seem to replace, while most of them work fine. Any idea why it's being selective?

 

[Peter_SSs]

... but some of the abbreviations don't seem to replace, .... Any idea why it's being selective?

Cannot really tell anything useful from the image provided. For a start, could you ..

• Make a copy of the workbook before any abbreviations have been made
• From Sheet1 remove all rows except the heading row and those two problem rows shown
• From Sheet6 remove all rows of abbreviations/replacements except ..
  • The heading row
  • The abbreviations that should be used in those two problem rows, and
  • Also leave say three other abbreviation rows that are not used by the two problem rows.
• Post the three rows of Sheet1 using XL2BB so I can copy the raw data. Only need column B
• Run the code again to check that the replacements are not fully working
• Post the three rows of Sheet1 again using XL2BB so I can copy the resultant error results. Again only column B
• Post the 6 or so rows & 2 relevant columns (E:F?) of Sheet6 using XL2BB so I can copy and repeat the test myself

 

[Blacksmith]

Cannot really tell anything useful from the image provided. For a start, could you ..

• Make a copy of the workbook before any abbreviations have been made
• From Sheet1 remove all rows except the heading row and those two problem rows shown
• From Sheet6 remove all rows of abbreviations/replacements except ..
  • The heading row
  • The abbreviations that should be used in those two problem rows, and
  • Also leave say three other abbreviation rows that are not used by the two problem rows.
• Post the three rows of Sheet1 using XL2BB so I can copy the raw data. Only need column B
• Run the code again to check that the replacements are not fully working
• Post the three rows of Sheet1 again using XL2BB so I can copy the resultant error results. Again only column B
• Post the 6 or so rows & 2 relevant columns (E:F?) of Sheet6 using XL2BB so I can copy and repeat the test myself

Here you go:

Book1
	B
2	TT OPC re PL DP
3	CT IC re DP
INPUT

Book1
	B
2	Telephone call(s) to OPC re: PL deposition
3	Correspondence to IC re: deposition
INPUT

Book1
	E	F
2	re	re:
3	IC	insurance carrier
4	PL	Plaintiff
5
6	OPC	opposing counsel
7
8
9
10
11	CT	correspondence to
12
13	CT	Correspondence to
14
15
16
17	TT	telephone call(s) to
18
19	TT	Telephone call(s) to
20
21
22
23
24
25
26
27	DP’s	depositions
28	DP	deposition
NOTOUCH

I just deleted the contents of the unused abbreviations rather than trying to remove the rows entirely.

 

[Peter_SSs]

Thanks. It does raise some more questions.

If you used the code from post #13 and the 2 sheets shown here are Sheet1 and Sheet6 (might be better to use the sheet name tab names?) then I cannot see how the code would produce those results.
The code works its way down the rows of Sheet6 (Is it NOTOUCH?) so ..

When it gets to row 17 (TT) (see comment below) it would replace TT with "telephone call(s) to"
Note the lower case "t" at the beginning.
When it gets to row 19 (TT) there is no TT left in the data now so nothing happens. Therefore the result would still start with a lower case "t" not an upper case one as you have shown in your results.
Same would happen with "correspondence"

Perhaps you have modified the code further after post #13? If so, either I would like to see the new code or note the comment below.

Comment: The issue of incorrect upper/lower case of the first letter should not arise if you followed what I said earlier:

Each abbreviation only needs to be listed once and the Replacement value should be capitalised in whatever way you would want that replacement if it was at the beginning of a sentence.

So I have run the post #13 code again twice using the data just supplied. The only change I made was to alter where the output went for comparison.
In column D are the results of the code with the data exactly as supplied in the previous post - results not capitalised correctly, but with all abbreviations replaced.
In column C are the results after I followed the quote above and also removed the data from rows 11 and 17 of NOTOUCH. Results now capitalised correctly and all abbreviations replaced.

If you are getting different results then either the code has changed or the data in your actual sheets is not identical to the data in the screen shots above. It could be that there are extra invisible characters in your data that did not come across with the XL2BB Add-In or perhaps some of your 'space' characters are not standard space characters and got replaced by the XL2BB process.

If you are still having problems and it is not making all the substitutions then perhaps you could upload a file with a small amount of dummy data & your current code to say DropBox or OneDrive etc and provide a shared link here? Then we could see exactly what is going on.

Blacksmith Multiple replace2.xlsm
	B	C	D
2	TT OPC re PL DP	Telephone call(s) to opposing counsel re: plaintiff deposition	telephone call(s) to opposing counsel re: plaintiff deposition
3	CT IC re DP	Correspondence to insurance carrier re: deposition	correspondence to insurance carrier re: deposition
INPUT