Autoselect Range of Text in a Text file

[swaggerbox]

I have a macro that formats a range of text that I have to manually select, but it is getting too tiring for comfort as I have to process over a hundred text files every single day. What I need to do is to automate the selection process and call the macro to format the said text. I need to autoselect the phrase because if other phrases are included in the processing, some words that should not be part of the processing gets erased or jumbled.


See example below.

Levetiracetam sustained release tablet, comprising levetiracetam and auxiliary material for releasing, parts by weight of the materials are as follows: 100 parts of levetiracetam, 3-60 parts of controlled release formulation, 30-70 parts of bonding agent, 30 parts of filler, and 1 part of lubricating agent.


I need to manually select "100 parts of levetiracetam, 3-60 parts of controlled release formulation, 30-70 parts of bonding agent, 30 parts of filler, and 1 part of lubricating agent." and run the formatting text macro that converts this phrase to "levetiracetam (100), controlled release formulation (3-60), bonding agent (30-70), filler (30), and lubricating agent (1)."


It would be better if i have something like this:


Autoselect Phrase
For each selected_phrase in sentences
Call Formatting_Text_Macro
Next selected_phrase


Could anyone help me with this?




Sub Formatting_Text_Macro()
Dim s() As String
Dim i As Integer
Dim strText As String
strText = Selection.Text

If Right(strText, 1) <> "." Then
strText = strText & "."
End If

s = Split(strText, " parts of ")
For i = 1 To UBound(s)
Dim strTemp As String
Dim strTempPrev As String

strTempPrev = s(i - 1)
strTemp = s(i)

Dim idxComma As Integer, idxPeriod As Integer, idxAnd As Integer, idx As Integer, idxLen As Integer

idx = 0
idxLen = 1
idxComma = InStr(strTemp, ",")
idxPeriod = InStr(strTemp, ".")
idxAnd = InStr(strTemp, " and ")

If idxComma = 0 Then
If idxPeriod = 0 Then
If idxAnd > 0 Then
idx = idxAnd
idxLen = 5
End If
Else
If idxAnd > 0 Then
If idxPeriod < idxAnd Then
idx = idxPeriod
Else
idx = idxAnd
idxLen = 5
End If
Else
idx = idxPeriod
End If
End If
End If
If idxPeriod = 0 Then
If idxComma = 0 Then
If idxAnd > 0 Then
idx = idxAnd
idxLen = 5
End If
Else
If idxAnd > 0 Then
If idxComma < idxAnd Then
idx = idxComma
Else
idx = idxAnd
idxLen = 5
End If
Else
idx = idxComma
End If
End If
End If
If idxAnd = 0 Then
If idxComma = 0 Then
If idxPeriod > 0 Then: idx = idxPeriod
Else
If idxPeriod > 0 Then
If idxComma < idxPeriod Then
idx = idxComma
Else
idx = idxPeriod
End If
Else
idx = idxComma
End If
End If
End If


If idx > 0 Then
Dim strLeftText As String
Dim strRightText As String

strLeftText = LTrim(RTrim(Left(strTemp, idx - 1)))
strRightText = LTrim(RTrim(Mid(strTemp, idx + idxLen)))

s(i - 1) = strLeftText & " (" & strTempPrev & ")"
s(i) = strRightText
End If
Next i

'display result
'For i = 0 To UBound(s) - 1
' MsgBox s(i)
'Next i
'display result
Dim retValue As String
retValue = s(0)
For i = 1 To UBound(s) - 1
If i = UBound(s) - 1 Then
retValue = retValue & ", " & s(i)
'retValue = retValue & " and " & s(i) & "."
'retValue = retValue & s(i) & "."
Else
retValue = retValue & ", " & s(i)
End If
Next i

Selection.Text = retValue

'Test = retValue
End Sub