It can be rules based if you know the rules
I had done something that uses a manually maintained list of Deletes and Replaces to (sort of) normalize Company names.
When there was a new oddball, I had to add it to the list
Capture.JPG
This is a user defined function, but could be converted to a sub and it'd probably run faster
Option Explicit
Function CleanUp(S As String, Deletes As Range, Replaces As Range) As String
Dim s1 As String, s2 As String, s3 As String, s4 As String
Dim v As Variant
Dim i As Long, iMatch As Long
Dim r As Range
'clean the input
s1 = Application.WorksheetFunction.Clean(S)
s1 = UCase(s1)
For i = 1 To Len(s1)
Select Case Mid(s1, i, 1)
Case "0" To "9", "A" To "Z", " ", "-", "/"
s2 = s2 & Mid(s1, i, 1)
End Select
Next i
'split at spaces
v = Split(s2, " ")
'see is each piece is a DELETE
For i = LBound(v) To UBound(v)
v(i) = Trim(v(i))
iMatch = -1
On Error Resume Next
iMatch = Application.WorksheetFunction.Match(v(i), Deletes.Columns(1), 0)
On Error GoTo 0
'if not -1 then found in DELETES column
If iMatch > -1 Then v(i) = vbNullString
Next
'put back togeather
s3 = Join(v, " ")
s3 = Trim(s3)
'check REPLACE THIS
'split at spaces
v = Split(s3, " ")
'see is each piece is a REPLACE THIS
For i = LBound(v) To UBound(v)
v(i) = Trim(v(i))
iMatch = -1
On Error Resume Next
iMatch = Application.WorksheetFunction.Match(v(i), Replaces.Columns(1), 0)
On Error GoTo 0
'if not -1 then found in REPLACE THIS column
If iMatch > -1 Then v(i) = Replaces.Cells(iMatch, 2).Value
Next
'put back togeather
s4 = Join(v, " ")
s4 = Trim(s4)
CleanUp = Application.WorksheetFunction.Proper(s4)
End Function