All,
I am trying to remove common company suffix names from a large dataset and the code I have below works to an extent but I am hoping to get some help to clean up the code and make it a little bit more user friendly.
I am hoping to replace the s1 array with a defined table (on Suffix tab called SuffixList) and as you can see there is multiple instances of same suffix due to commas, periods, or spaces. If there is a way to catch those so we dont have to list multiple versions of the same suffix, that would be greatly appreciated.
End Sub
I am trying to remove common company suffix names from a large dataset and the code I have below works to an extent but I am hoping to get some help to clean up the code and make it a little bit more user friendly.
I am hoping to replace the s1 array with a defined table (on Suffix tab called SuffixList) and as you can see there is multiple instances of same suffix due to commas, periods, or spaces. If there is a way to catch those so we dont have to list multiple versions of the same suffix, that would be greatly appreciated.
VBA Code:
Sub Remove_Suffix()
Application.ScreenUpdating = False
Dim cel As Range
Dim nameRange As Range
Set nameRange = Sheets("Data").Range("C16:C1015")
Dim s1 As Variant
s1 = Array(" AB", " AS", " AG", " BV", " OP", " NV", " Plc", " SA", " SNC", ", NA", " NA", " SAS", " SpA", " Pty", " A/S", " SGIIC", " UA", " SGR", ", LLLP.", ", LLLP", " LLLP.", " LLLP", ", LLP.", ", LLP", " LLP.", " LLP", ", LP.", ", LP", ", L.P.", " LP.", " LP", " SA", " GmbH", "mbH", ", LLC", " LLC", " Corp.", ", Ltd.", ", Ltd", " Ltd.", " Ltd.", " MDTA", ", FSB", " FSB", " DAC", " ULC", " Ltda.", "LTD", ", LTD", ", INC.", ", INC.+", ",LLC+", ", L.L.C")
Dim lenName As Integer
Dim lenSuffix As Integer
Dim rightEnd As String
For Each cel In nameRange
lenName = Len(cel)
' if statement to remove "()" that end a company name
lenSuffix = Len(") ")
rightEnd = Right(cel, lenSuffix)
If InStr(rightEnd, ")") Then
cel = Left(cel, InStr(cel, "(") - 2)
End If
For Each Suffix In s1
lenSuffix = Len(Suffix)
rightEnd = Right(cel, lenSuffix)
If InStr(rightEnd, Suffix) Then
cel.Replace What:=Suffix, Replacement:=""
Exit For
End If
Next Suffix
Next cel
End Sub