VBA Function Random Alpha for Numbers

[Stephen_IV]

Good afternoon,

In this post I am looking for a VBA function not a formula approach. I an trying to substitute Random Alphas (all uppercase) for numbers in a cell. For example if A1 housed 1001204 then based on the key below I would be looking for something like EVRNLVZ in B1. Since it is random it will always change. I have a list of about 11,000 numbers that I need to do this too. Can anyone please help me with this! Thanks in advance.

This is the key that I am looking for:

0 = H,V or R
1 = N,S,or E
2 = D or L
3 = A,J, or Y
4 = Q,T, or Z
5 = B, M, or U
6 = F or I
7 = C,O, or X
8 = K or P
9 = G or W

 

[hurgadion]

Hi,
write please the String 1001204 in A1 ad try use the macro:

Sub RandomCode()
Dim tbl(), a As String, b As String, d As String, x&

ReDim tbl(0 To 9)
tbl(0) = "HVR"
tbl(1) = "NSE"
tbl(2) = "DL"
tbl(3) = "AJY"
tbl(4) = "QTZ"
tbl(5) = "BMU"
tbl(6) = "FI"
tbl(7) = "COX"
tbl(8) = "KP"
tbl(9) = "GW"

Randomize
a = Cells(1, 1).Value
For i = 1 To Len(a)
  b = Mid(a, i, 1)
  x = Int(1 + Len(tbl(b)) * Rnd)
  d = d & Mid(c, x, 1)
Next i

Cells(1, 2).Value = d
End Sub

Best regards.

 

[Stephen_IV]

hurgadion,
Thanks for the response. I tried it and it is not working. I am not getting any results in column B.

 

[hurgadion]

OK, it was a small mistake, try now:

Sub RandomCode()
Dim tbl(), a As String, b As String, c As String, d As String, x&

ReDim tbl(0 To 9)
tbl(0) = "HVR"
tbl(1) = "NSE"
tbl(2) = "DL"
tbl(3) = "AJY"
tbl(4) = "QTZ"
tbl(5) = "BMU"
tbl(6) = "FI"
tbl(7) = "COX"
tbl(8) = "KP"
tbl(9) = "GW"

Randomize
a = Cells(1, 1).Value
For i = 1 To Len(a)
  b = Mid(a, i, 1)
  c = tbl(b)
  x = Int(1 + Len(c) * Rnd)
  d = d & Mid(c, x, 1)
Next i

Cells(1, 2).Value = d
End Sub

Best regards.

 

[Rick Rothstein]

Here is another macro for you to consider...

Sub ReplaceDigits()
  Dim X As Long, Z As Long, LastRow As Long, ReplacedDigits As String
  Const StartRow As Long = 1
  Const DataColumn As String = "A"
  Const Replacements As String = "HVRHVRNSENSEDLDLDLAJYAJYQTZQTZBMUBMUFIFIFICOXCOXKPKPKPGWGWGW"
  Static RandomizedYet As Boolean
  '  It is better to run Randomize only once per session
  If Not RandomizedYet Then
    Randomize
    RandomizedYet = True
  End If
  LastRow = Cells(Rows.Count, DataColumn).End(xlUp).Row
  For Z = StartRow To LastRow
    ReplacedDigits = Cells(Z, DataColumn).Value
    For X = 1 To Len(ReplacedDigits)
      Mid(ReplacedDigits, X) = Mid(Replacements, 6 * Mid(ReplacedDigits, X, 1) + 1 + Int(6 * Rnd), 1)
    Next
    Cells(Z, DataColumn).Offset(, 1).Value = ReplacedDigits
  Next
End Sub

 

[Stephen_IV]

Thanks Rick worked perfectly! hurgadion your code just did it on 1 cell I was looking for the range. Thanks you though for your help. Another question once the string is converted to alpha i.e.(EVRNLVZ) can I please have some code to convert it back to numeric i.e. (1001204) using the same table?

0 = H,V or R
1 = N,S,or E
2 = D or L
3 = A,J, or Y
4 = Q,T, or Z
5 = B, M, or U
6 = F or I
7 = C,O, or X
8 = K or P
9 = G or W

 

[hurgadion]

My above Cell-Solution can be easily reorganized to Range-Solution. Back-Solution for coded String can be solved by the macro:

Sub RandomUnCode()
Dim tbl(), a As String, c As String, d As String, i&, j&

ReDim tbl(0 To 9)
tbl(0) = "HVR"
tbl(1) = "NSE"
tbl(2) = "DL"
tbl(3) = "AJY"
tbl(4) = "QTZ"
tbl(5) = "BMU"
tbl(6) = "FI"
tbl(7) = "COX"
tbl(8) = "KP"
tbl(9) = "GW"

a = Cells(1, 2).Value
For i = 1 To Len(a)
  c = Mid(a, i, 1)
  For j = 0 To 9
    If tbl(j) Like "*" & c & "*" Then
      d = d & j
      Exit For
    End If
  Next j
Next i

Cells(1, 3).Value = d
End Sub

Try reorganize Cell-Solution to Range-Solution. This is Your HomeWork

Best regards.

 

[Rick Rothstein]

Thanks Rick worked perfectly! hurgadion your code just did it on 1 cell I was looking for the range. Thanks you though for your help. Another question once the string is converted to alpha i.e.(EVRNLVZ) can I please have some code to convert it back to numeric i.e. (1001204) using the same table?

0 = H,V or R
1 = N,S,or E
2 = D or L
3 = A,J, or Y
4 = Q,T, or Z
5 = B, M, or U
6 = F or I
7 = C,O, or X
8 = K or P
9 = G or W

This code should reverse it (reads letters in Column B, outputs to Column C)...

Sub ReplaceLetters()
  Dim X As Long, Z As Long, LastRow As Long, ReplacedLetters As String
  Const StartRow As Long = 1
  Const DataColumn As String = "B"
  Const Replacements As String = "HVRNSEDL AJYQTZBMUFI COXKP GW "
  Static RandomizedYet As Boolean
  LastRow = Cells(Rows.Count, DataColumn).End(xlUp).Row
  For Z = StartRow To LastRow
    ReplacedLetters = Cells(Z, DataColumn).Value
    For X = 1 To Len(ReplacedLetters)
      Mid(ReplacedLetters, X, 1) = Int(InStr(Replacements, Mid(ReplacedLetters, X, 1)) - 1) / 3
    Next
    Cells(Z, DataColumn).Offset(, 1).Value = ReplacedLetters
  Next
End Sub

 

[Stephen_IV]

Beautiful! Thanks you so much Rick! I really appreciate it!