Solution required for a repeating Excel Work

[Abbas999]

Hi All,

I regularly have some excel sheets to filter. From each sheet i have to do two things.

First Thing
Removing companies lables i.e

1. inc.
2. ltd.
3. Corp.
4. LLC, PLLC, LP, P.C., N.V, S.A and similar.
5. Consultting, Holding, Group, Company, GMBPH and similar.

Second Thing
There is column with Full names. I have to split them into First and last names at the end (it's possible with text to columns feature) . But before that I have to remove,

Middle names, Prefix, CFA, MBA, CPC, PH.D Esq. and many more.
Also Middle names i.e:
Q. W. E. R. and so on to M. (all keyboard letters)


I was doing all this find and replace. But this is becoming boring as i have to regularly do this. I am hoping for a one click solution. Like two VBA codes. One for Names and Second code for companies.

Feeling very hopeful because i got many excel problems solved here. Thanks

 

[dave3009]

OK, Can you post a small example of before and after. I'd rather try finding a solution to fit than 'best guess'. If you need to mask the company names that's fine but please try to make say a set of 10-20 that are at least fairly representative of your needs.

 

[Abbas999]

OK, Can you post a small example of before and after. I'd rather try finding a solution to fit than 'best guess'. If you need to mask the company names that's fine but please try to make say a set of 10-20 that are at least fairly representative of your needs.

Hi @dave3009

I have created a list of companies. This is most likely extra names of each company.

[TABLE="width: 304"]
<colgroup><col></colgroup><tbody>[TR]
[TD]4Life Inc.[/TD]
[/TR]
[TR]
[TD]4Life Inc[/TD]
[/TR]
[TR]
[TD]4Life (inc.)[/TD]
[/TR]
[TR]
[TD]4Life (inc)[/TD]
[/TR]
[TR]
[TD]4Life Corporation.[/TD]
[/TR]
[TR]
[TD]4Life Corporation[/TD]
[/TR]
[TR]
[TD]4Life Corp.[/TD]
[/TR]
[TR]
[TD]4Life Corp[/TD]
[/TR]
[TR]
[TD]4Life Limited.[/TD]
[/TR]
[TR]
[TD]4Life Limited[/TD]
[/TR]
[TR]
[TD]4Life Ltd.[/TD]
[/TR]
[TR]
[TD]4Life Ltd[/TD]
[/TR]
[TR]
[TD]4Life LLC.[/TD]
[/TR]
[TR]
[TD]4Life LLC[/TD]
[/TR]
[TR]
[TD]4Life L.L.C[/TD]
[/TR]
[TR]
[TD]4Life PLC[/TD]
[/TR]
[TR]
[TD]4Life PLLC.[/TD]
[/TR]
[TR]
[TD]4Life PLLC[/TD]
[/TR]
[TR]
[TD]4Life L.L.p.[/TD]
[/TR]
[TR]
[TD]4Life LLp.[/TD]
[/TR]
[TR]
[TD]4Life Lp.[/TD]
[/TR]
[TR]
[TD]4Life N.V.[/TD]
[/TR]
[TR]
[TD]4Life N.V[/TD]
[/TR]
[TR]
[TD]4Life A.G[/TD]
[/TR]
[TR]
[TD]4Life S.A.[/TD]
[/TR]
[TR]
[TD]4Life S.A[/TD]
[/TR]
[TR]
[TD]4Life & Co.[/TD]
[/TR]
[TR]
[TD]4Life & Co[/TD]
[/TR]
[TR]
[TD]4Life & Company[/TD]
[/TR]
[TR]
[TD]4Life Company[/TD]
[/TR]
[TR]
[TD]4Life Holdings[/TD]
[/TR]
[TR]
[TD]4Life Holding[/TD]
[/TR]
[TR]
[TD]4Life Consulting[/TD]
[/TR]
[TR]
[TD]4Life GmbH.[/TD]
[/TR]
[TR]
[TD]4Life GmbH[/TD]
[/TR]
[TR]
[TD]4Life Group.[/TD]
[/TR]
[TR]
[TD]4Life Group[/TD]
[/TR]
[TR]
[TD]4Life P.A.[/TD]
[/TR]
[TR]
[TD]4Life P.A[/TD]
[/TR]
[TR]
[TD]4Life Pty Limited.[/TD]
[/TR]
[TR]
[TD]4Life Pty Limited[/TD]
[/TR]
[TR]
[TD]4Life Pty Ltd.[/TD]
[/TR]
[TR]
[TD]4Life Pty Ltd[/TD]
[/TR]
[TR]
[TD]4Life.com[/TD]
[/TR]
[TR]
[TD]4Life.net[/TD]
[/TR]
[TR]
[TD]4Life.org[/TD]
[/TR]
[TR]
[TD]4Life Cpa P.A.[/TD]
[/TR]
[TR]
[TD]4Life Cpa P.A[/TD]
[/TR]
[TR]
[TD]4Life Cpa PA[/TD]
[/TR]
[TR]
[TD]4Life Private Limited.[/TD]
[/TR]
[TR]
[TD]4Life Private Limited[/TD]
[/TR]
[TR]
[TD]4Life Private Ltd.[/TD]
[/TR]
[TR]
[TD]4Life Private Ltd[/TD]
[/TR]
[TR]
[TD]4Life P.C.[/TD]
[/TR]
[TR]
[TD]4Life P.C[/TD]
[/TR]
[TR]
[TD]4Life Consultant[/TD]
[/TR]
[TR]
[TD]4Life Consultants[/TD]
[/TR]
</tbody>[/TABLE]


Let me know if you can help me.

 

[dave3009]

Hi Abbas999,

This will look at the value and see if any of the exclusions (I didn't do all of them) exist and remove them, it will be fair more exacting than Find/Replace.

Can you try it on a small segment of a COPY of your data and let me know how it goes. If this is close then we can build a bit further.

Sub abbas999()
Dim coName As Variant
Dim part As Variant
Dim exclusions As Variant
Dim newName As String
Dim lstRw As Long
Dim curRw As Long


exclusions = Array("LLC", "LLC.", "P.A", "P.A.", "Ltd", "Ltd.", "Limited", "Limited.", "Co", "Co.")


lstRw = Range("A" & Rows.Count).End(xlUp).Row
For curRw = 1 To lstRw
    coName = Split(Range("A" & curRw), " ")
    For part = 0 To UBound(coName)
        If UBound(Filter(exclusions, coName(part))) >= 0 Then
            'do nothing
        Else
            newName = newName & " " & coName(part)
        End If
    Next part
    Range("A" & curRw) = Trim(newName)
    newName = ""
Next curRw


End Sub