VBA EXCEL : Pattern creation function replacing numbers with characters

Question

I have written the below mentioned code but its not functional. Can anyone help?

Explanation: A 7 or 8 digit number is set. If the number is 8 digits, the first 2 numbers are removed, if the number is 7 digits, the first number is removed. A 6 digit number is left whereby every digit can be repeated without any constraints. So one can have a number between 000001 and 999999. (Zeros on the left are counted).

The code is functional on the first 3 digits but does not function properly later on though i'm using the same logic. The function of the code is to Generate all possible patterns by translating the numbers into characters.

The constraints:

• Letters used are only a, b, c, d, e, and f.
• Characters should run systematic order

Under this logic:

• The pattern can range between aaaaaa and abcdef.
• The first character is always "a" and the last character could be "f" in case all digits are different from one another.

So, the number 454657 is translated to abacbd or 123456 is translated to abcdef. (c Can't exist if there is no b and d can't exist if there is no b and c).

 Private Sub CommandButton1_Click()
        Dim GSM_Counter, GSM, GSM_Range, a, b, c, d, e, f As String
        Dim GSM_length, Num1, Num2, Num3, Num4, Num5, Num6, a1, b1, c1, d1, e1, f1 As integer
        GSM_Counter = Application.WorksheetFunction.CountA(Range("A:A"))
For i = 2 To GSM_Counter
        GSM_length = Len(Range("A" & i))
            Select Case GSM_length
                Case Is = 8
                    Range("B" & i) = Left(Range("A" & i), 2)
                    Num1 = Right(Left(Range("A" & i), 3), 1)
                    Num2 = Right(Left(Range("A" & i), 4), 1)
                    Num3 = Right(Left(Range("A" & i), 5), 1)
                    Num4 = Right(Left(Range("A" & i), 6), 1)
                    Num5 = Right(Left(Range("A" & i), 7), 1)
                    Num6 = Right(Left(Range("A" & i), 8), 1)
            Case Is = 7
                Range("B" & i) = Left(Range("A" & i), 1)
                Num1 = Right(Left(Range("A" & i), 2), 1)
                Num2 = Right(Left(Range("A" & i), 3), 1)
                Num3 = Right(Left(Range("A" & i), 4), 1)
                Num4 = Right(Left(Range("A" & i), 5), 1)
                Num5 = Right(Left(Range("A" & i), 6), 1)
                Num6 = Right(Left(Range("A" & i), 7), 1)
            End Select
                Range("C" & i) = Num1
                Range("D" & i) = Num2
                Range("E" & i) = Num3
                Range("F" & i) = Num4
                Range("G" & i) = Num5
                Range("H" & i) = Num6
Next i

For k = 2 To GSM_Counter
                a1 = Range("C" & k)
                b1 = Range("D" & k)
                c1 = Range("E" & k)
                d1 = Range("F" & k)
                e1 = Range("G" & k)
                f1 = Range("H" & k)
                a = "a"
                Range("K" & k) = a
                If b1 = a1 Then
                    b = "a"
                    Else
                    b = "b"
                End If
                Range("L" & k) = b
                If c1 = a1 Then
                    c = "a"
                    ElseIf c1 = b1 Then
                    c = "b"
                    Else
                    c = "c"
                End If
                Range("M" & k) = c
                If d1 = a1 Then
                    d = "a"
                    ElseIf d1 = b1 Then
                    d = "b"
                    ElseIf d1 = c1 Then
                    d = "c"
                    Else
                    d = "d"
                End If
                Range("N" & k) = d
                If e1 = a1 Then
                    e = "a"
                    ElseIf e1 = b1 Then
                    e = "b"
                    ElseIf e1 = c1 Then
                    e = "c"
                    ElseIf e1 = d1 Then
                    e = "d"
                    Else
                    e = "e"
                End If
                Range("O" & k) = e
                If f1 = a1 Then
                    f = "a"
                    ElseIf f1 = b1 Then
                    f = "b"
                    ElseIf f1 = c1 Then
                    f = "c"
                    ElseIf f1 = d1 Then
                    f = "d"
                    ElseIf f1 = e1 Then
                    f = "e"
                    Else
                    f = "f"
                End If
                Range("P" & k) = f
                Next k
End Sub

Answer 1

Here is another way..

'~~> Test Data
Sub Sample()
    Dim TestArray(1 To 6) As Long
    Dim i As Long

    TestArray(1) = 468013: TestArray(2) = 12234455: TestArray(3) = 234523
    TestArray(4) = 44444444: TestArray(5) = 123: TestArray(6) = 111222

    For i = 1 To 6
        Debug.Print TestArray(i) & " --> " & Encrypt(TestArray(i))
    Next i
End Sub

'~~> Actual Function
Function Encrypt(n As Long) As String
    Dim j As Long, k As Long, sNum As String

    sNum = Format(CLng(Right(n, 6)), "000000")

    j = 97

    For k = 1 To 6
        If IsNumeric(Mid(sNum, k, 1)) Then
            sNum = Replace(sNum, Mid(sNum, k, 1), Chr(j))
            j = j + 1
        End If
    Next k
    Encrypt = sNum
End Function

Output

468013 --> abcdef
12234455 --> abccdd
234523 --> abcdab
44444444 --> aaaaaa
123 --> aaabcd
111222 --> aaabbb

EDIT :

If you are planning to use it as a worksheet function and you are not sure what kind of input will be there then change

Function Encrypt(n As Long) As String

to

Function Encrypt(n As Variant) As String

Answer 2

I would suggest getting to know the Chr() and possibly the Asc() VBA functions along with a general knowledge of how digits and alphabetic characters translate to ASCII code characters. I may be reading things wrong but I thought I saw some contradictions between the examples, your description and the actual code provided. Here is one method putting the pattern generation into a User Defined Function or UDF .

Function num_2_alpha(sNUM As String)
    'ASCII 0-9 = 46-57, a-z = 97-122
    Dim tmp As String, i As Long, c As Long
    sNUM = Right(sNUM, 6)
    tmp = Chr(97) ' =a
    For i = 2 To 6
        If CBool(InStr(1, Left(sNUM, i - 1), Mid(sNUM, i, 1))) Then
            tmp = tmp & Mid(tmp, InStr(1, Left(sNUM, i - 1), Mid(sNUM, i, 1)), 1)
        Else
            'tmp = tmp & Chr(i + 96)
            c = c + 1
            tmp = tmp & Chr(c + 97)   'alternate (code) method
        End If
    Next i
    num_2_alpha = tmp
End Function

Note that I've offered an alternate method that is commented out. Either that line or the one above it should be active; never both at one time. These were the results generated.

Addendum: I believe my recent edit should help conform to the examples you left in comments. Code and image updated.