i want a unique code of 3 alphanumeric text from a artistic text lines for example
parag PAR
corel8 CR8
coreldraw-x6 CX6
etc
just like the excel example but i need with different characters.
charactet should not be repeat. 3 characters are same then it should take next available character of that word for example
father fat
father fah
father fae
father far
father fth
father fte
father ftr
etc like this nothing else from this.
Put the next code in an Excel module and your 'father' text in column A:A:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49
Option Explicit Private M() As String Sub TestThreeUniqueChar() Dim Interm As Variant, lastRow As Long, strPat As String, El As Variant Dim boolFound As Boolean, i As Long boolFound = False: ReDim M(1) lastRow = ActiveWorkbook.ActiveSheet.Range("A1").End(xlDown).Row Interm = ActiveSheet.Range("A1:A" & lastRow).Value Columns("B:B").Clear For i = 1 To lastRow strPat = Left(Interm(i, 1), 3) For Each El In M() If El = strPat Then boolFound = True: Exit For Next If boolFound = False Then ActiveSheet.Range("B" & i).Value = strPat M(i) = strPat: ReDim Preserve M(i + 1) Else strPat = uniquePattern(Interm(i, 1), strPat, i) End If Next End Sub Function uniquePattern(ByVal strVal As String, strPat As String, i As Long, Optional J As Long) Dim uniqueP As String, boolFound As Boolean, El As Variant If J <= 4 Then J = 4: boolFound = False uniqueP = Left(strPat, 2) & Mid(strVal, J, 1) For Each El In M() If El = uniqueP Then boolFound = True: Exit For Next If boolFound = False Then If Len(uniqueP) = 3 Then ActiveSheet.Range("B" & i).Value = uniqueP M(i) = uniqueP: ReDim Preserve M(i + 1) Else ActiveSheet.Range("B" & i).Value = "Not enough characters" ReDim Preserve M(i + 1) End If Else J = J + 1 If J <= Len(strVal) Then uniquePattern strVal, strPat, i, J Else If Mid(strVal, 4, 1) <> "" Then uniquePattern strVal, Left(strPat, 1) & Right(strPat, 1) & Mid(strVal, 4, 1), i End If End If End If End Function
If you will have a following word not having enough characters to obtain a unique pattern based on your suggested algorithm it will return "Not enough characters" and you will improve the algorithm (adding 1, 2, x, etc) or you will make the pattern manually...
You will obtain something like this:
If you need that code to work in Corel you just need to change the lines 8 and 9 in order to load the list and also the returning sequence, to do that wherever you need.
Is that OK with you?
this is absolutely ok with me butwhat changes i have to made in 8th and 9th if i want to use in corel?i tried with this word "corel draw x6" in excel 2007 with around 51 copies but macro made only unique codes of only 27 letters only then error comes it is showing me a error in excel 2007run time error 28... out of stack spacewhat should i do nowcan we use this in corel directly ?can you share full code of corel draw ?
In that lines the code transfers in an array all the words necessary to be processed. After that everything is the same, except the place where the result must be written. I didn't develop the code to solve an infinite number of cases. Because I considered that it is not necessary. Would you have such a case of more then 27 similar cases of Logo? Or you just wont to annoy people here? Did you try to understand the logic of the code? I would be able to share but I couldn't understand where do you keep the words necessary to be processed and where do you wont to return the resulted patterns (in Corel). I remember you asked a new artistic test having the patterns on its column. I think I have a lot of imagination but I'm still asking myself how will you use it and I didn't want to work like Sisyphus. Besides that I still think i's time for you to learn some VBA and understand what is happening there... If you need only solutions I'm afraid here is not the most appropriate place to ask.