can we make a unque code of alphanumeric from text

i want a unique code of 3 alphanumeric text from a artistic text lines for example

parag PAR

corel8 CR8

coreldraw-x6 CX6

etc

Put the next code in an Excel module and your 'father' text in column A:A:

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:

father	fat
father	fah
father	fae
father	far
father	fth
father	fte
father	ftr
fatu	fau
fae	Not enough characters
fatherus	fas

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?