i want a unique code of 3 alphanumeric text from a artistic text lines for example
parag PAR
corel8 CR8
coreldraw-x6 CX6
etc
Like most of us explained it is easy to find a three digits 'code' JUST in order to be unique but not to give it a signification to logically link them by their 'father'. You answered to my question saying that this three characters abbreviation MUST HAVE a signification for the one looking at it! How do you say now that "they just should be different from other"? Don't you understand the difference? If you know what are saying, you already have a piece of code doing that... Posted by NudeFan. Since you are limited only by the area, maybe you can use a smaller font...
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.
VSTA Macro for CorelDraw X8 64bit
Demo:
Maybe help you write your code
seriously amazing sir how can i install this this is not a normal gms file ?
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 ?