VBA to replace text at end of string in Access 2007

[Brad Richmond]

Within a table (tbl_Companies) I have a field (Company_Name) used to store a list of Company Names that I have pulled from multipe sources. I would like to clean the data within the table to remove duplicates.

I have identified a few substrings (including any derivation of case) I would like to remove from the end of each Company Name where present:

1. " Corporation"
2. " Incorporated"
3. " Company"
4. " Limited"
5. " Corp"
6. " Co Inc"
7. " Co LLC"
8. " Co"
9. " Plc"
10. " Ltd"
11. " LLC"
12. " Inc"

An example would be "River College Inc" = "River College" (and not "Riverllege Inc" or "Riverllege ").

Can someone please provide some guidance to assist?

Thank you,

BDS

[Rabbit]

You can use a series of regular expression replacements to get rid of those phrases at the end.

[Brad Richmond]

Thank you for the response Rabbit. I was thinking of something along these lines instead of using a replace:

'Remove legal entity types from end of string
Public Function strRemType(strText As String) As String

Dim strChar As String
    strChar = " Corporation"
    
    If Len(strChar) + (InStr(strText, strChar) - 1) = Len(strText) Then
        strText = Left(strText, Len(strText) - Len(strChar))
        
    Else
        strText = strText
        
    End If
    
strRemType = strText

End Function

I'm trying to determine what the best way is to do this across all of the substrings I'm trying to remove (as opposed to just copying each of the statements down and changing the strChar = " " part of the function).

Thanks again.

[zmbd]

Before you can use RegEX() in Ms Access, go to the VBA, References, and find the library:
"Microsoft VBScript Regular Expressions #.#"
Otherwise RegEx Will throw a tempertantrum during the debug/compile
:)

[Brad Richmond]

Thank you Rabbit and zmbd. I've made some changes to implement this using RegEx via a function and sub but still had two items I'm trying to figure out:

1. For some reason neither the function or sub appear to be working properly based on my tests. I wanted to see if you could see anything wrong with the code.

2. Is it possible to declare more than one .pattern in the function so I can list out all of the combinations of characters I want removed? Also - since the order of which characters are being removed through the loop is important, will any suggestions take into account that consideration?

See updated code:

Private mlv As Object

Function RemoveType(strText As String) As String
    
If mlv Is Nothing Then
    Set mlv = CreateObject("vbscript.regexp")

End If
    
With mlv
    .Pattern = " Corporation$"
    .IgnoreCase = False
    .Global = False

    If .Test(strText) Then
        RemoveType = strText
    
    End If
    
End With
    
End Function

Sub main()
 
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim mySQL As String
Dim strColumn2, strColumn3  As String
 
Set db = CurrentDb()
 
mySQL = "SELECT Company_Name, strCompany_Name FROM tbl_Distressed_Companies_Master"

Set rs = db.OpenRecordset(mySQL)

rs.MoveFirst

Do Until rs.EOF
    strColumn2 = rs.Fields("Company_Name")
    strColumn3 = Trim(RemoveText(Trim(strColumn2)))

If Len(strColumn3) <> Null Then
    rs.Edit
    rs.Fields("strCompany_Name").Value = strColumn3
    rs.Update

End If

rs.MoveNext

Loop

Set mlv = Nothing

End Sub

[Rabbit]

You didn't actually remove the text you were searching for, you only tested for it.

As for your list of values, I would just put them in an array or table and loop through each running the regexp replacement mutliple times.

Though if you want, you can do it in one regexp by using the or functionality.