Abbreviation and numbering question

[Taniquetil]

Hi,


I have a list of account names which i need to give codes to. each code format = First four letter of company name followed by 3 numbers starting at 200

eg. Artshop, Bookstore, Apple Co would be

ARTS200
BOOK200
APPL200

if i were to add artstore, and bookshop and appleseed drinks they would be

ARTS201
BOOK201
APPL201

etc etc. is there a way this can be done if i have a column with the company names in to automatically create these codes?

slight problem. cant have symbols or spaces etc in the code. so they would need to read as follows

Dr & Lyle = DRLY200
St-German = STGE200
St George = STGE201

any help appreciated, i also understand that the latter may be close to impossible so going through manually wouldnt be a problem. maybe making those codes return an error rather than populating the cell with an incorrect value would be better.

Thank you in advance

 

[Sektor]

Then it's impossible 'cause I need to know the location of previous cells to extract value. I can just only guess that it will we be atop.

 

[Taniquetil]

I thought the first post describes the logic. The first time the letter code occurs the code is 200. If the same letter code repeats the number code is 201 etc.

Thank you Peter_SS this is indeed the logic i require, but lack the VBA knowledge to execute, i still havent been able to figure out how to run Sektors code, ive inserted it as a module and tried pressing play but nothing happens. what am i doing wrong?

I admire the level of understanding it takes to operate computers like you guys do!

 

[Sektor]

Why pressing F5? U use it like usual Excel's function.
Type in a cell: =Abbrev(A1;200).

To adjust number I need to know location of previous cells to watch all of them whether there's already similar abbreviation. Won't range have gaps?

 

[MickG]

Try this:- Not sure if its exactly what you want,
Your data column "A"
Results column "B"

[COLOR=navy]Sub[/COLOR] MG27May30
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] txt [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & rows.Count).End(xlUp))
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    txt = UCase(Left(Replace(Replace(Replace(Dn, " ", ""), "&", ""), "-", ""), 4))
        [COLOR=navy]If[/COLOR] Not .Exists(txt) [COLOR=navy]Then[/COLOR]
            .Add txt, 1
            Cells(Dn.row, 2) = txt & 199 + 1
        [COLOR=navy]Else[/COLOR]
            .Item(txt) = .Item(txt) + 1
            Cells(Dn.row, 2) = txt & 199 + .Item(txt)
        [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
[COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[Taniquetil]

Ah ok Sektor, i have the company names in column K and i want the Account code (eg DAVE200) to appear in column L

thanks

 

[Taniquetil]

runtime error 429 mick but thank you for your efforts. my primitive brain tried to read your code language and the logic seems sound, create the dictionary and adjust all the numbers to never match. i can send you guys a sample of the sheet im using if you like?

 

[MickG]

Try the code agian , it was incorrect, but I've altered it.
Data & Results below

[COLOR="RoyalBlue"][B]Row No [/B][/COLOR] [COLOR="RoyalBlue"][B]Col(A)      [/B][/COLOR] [COLOR="RoyalBlue"][B]Col(B)  [/B][/COLOR]
1.      Artsroom     ARTS200 
2.      Applestore   APPL200 
3.      Bookmart     BOOK200 
4.      artsweek     ARTS201 
5.      bookroom     BOOK201 
6.      appletin     APPL201 
7.      Dr & LyleLy  DRLY200 
8.      St- Gerge    STGE200 
9.      St Gemmm     STGE201 
10.     artsmaker    ARTS202 
11.     artsarts     ARTS203

Regards Mick

 

[Peter_SSs]

Mick's code that he has removed I believe was close to the mark (apart from looking at the correct columns that you have just advised) and I assume he will post new code shortly.

One question I have is: Would it be possible that a Company name could be less than 4 characters long (eg ACE)? If so what would you want to do with the letter part of the final code in that circumstance?

 

[Sektor]

I guess, there will be 3 characters.

 

[MickG]

Try Again !!

[COLOR="Navy"]Sub[/COLOR] MG27May33
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("K1"), Range("K" & rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    txt = UCase(Left(Replace(Replace(Replace(Dn, " ", ""), "&", ""), "-", ""), 4))
        [COLOR="Navy"]If[/COLOR] Not .Exists(txt) [COLOR="Navy"]Then[/COLOR]
            .Add txt, 1
            Cells(Dn.row, "L") = txt & 199 + 1
        [COLOR="Navy"]Else[/COLOR]
            .Item(txt) = .Item(txt) + 1
            Cells(Dn.row, "L") = txt & 199 + .Item(txt)
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Results

[COLOR="RoyalBlue"][B]Row No [/B][/COLOR] [COLOR="RoyalBlue"][B]Col(K)       [/B][/COLOR] [COLOR="RoyalBlue"][B]Col(L)  [/B][/COLOR]
1.      Artsroom      ARTS200 
2.      Applestore    APPL200 
3.      Bookmart      BOOK200 
4.      artsweek      ARTS201 
5.      bookroom      BOOK201 
6.      appletin      APPL201 
7.      Dr & LyleLy   DRLY200 
8.      St- Gerge     STGE200 
9.      St Gemmm      STGE201 
10.     artsmaker     ARTS202 
11.     artsarts      ARTS203 
12.     Apple a day   APPL202 
13.     Books & Mags  BOOK202 
14.     Arts & Parts  ARTS204

Regards Mick