Replace Alpha with Numeric Character

[Gos-C]

Hi all,

Each cells in a column E range contains a 15-character numeric or alphanumeric string - e.g., 000000123456789, 000000000F16520, 000000TEST12345 and 000000000123XY9. I have to add a number to the cell value and then multiply it by another number. Therefore, I need to replace all alpha with numeric characters. I am having difficulty writing the code. Here is what I have:

Sub ReplaceAlpha()
Dim rCell As Range
Dim lLR As Long
lLR = Cells(Rows.Count, "E").End(xlUp).Row
For Each rCell In Range("E2:E" & lLR)
rCell = Search(rCell, "a", 1)
rCell = Search(rCell, "b", 2)
rCell = Search(rCell, "c", 3)
rCell = Search(rCell, "d", 4)
rCell = Search(rCell, "e", 5)
rCell = Search(rCell, "f", 6)
rCell = Search(rCell, "g", 7)
rCell = Search(rCell, "h", 8)
rCell = Search(rCell, "i", 9)
rCell = Search(rCell, "j", 1)
rCell = Search(rCell, "k", 2)
rCell = Search(rCell, "l", 3)
rCell = Search(rCell, "m", 4)
rCell = Search(rCell, "n", 5)
rCell = Search(rCell, "o", 6)
rCell = Search(rCell, "p", 7)
rCell = Search(rCell, "q", 8)
rCell = Search(rCell, "r", 9)
rCell = Search(rCell, "s", 1)
rCell = Search(rCell, "t", 2)
rCell = Search(rCell, "u", 3)
rCell = Search(rCell, "v", 4)
rCell = Search(rCell, "w", 5)
rCell = Search(rCell, "x", 6)
rCell = Search(rCell, "y", 7)
rCell = Search(rCell, "z", 8)
End Sub

Can someone help me, please.

Thank you,
Gos-C

 

[Trebor76]

Hi Gos-C,

Does the string have to remain 15 characters as with each letter that has a two digit equivalent (i.e. J to Z) the length of the string will grow by one.

Robert

 

[hiker95]

Gos-C,


Sample raw data before the macro:

Excel Workbook
	E
2	000000123456789
3	000000000F16520
4	000000TEST12345
5	000000000123XY9
6
Sheet1

After the macro:

Excel Workbook
	E
2	000000123456789
3	000000000616520
4	000000251212345
5	000000000123679
6
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub ReplaceAlphaV2()
' hiker95, 03/28/2011
' http://www.mrexcel.com/forum/showthread.php?t=539183
Dim c As Range, a As Long, H As String
Application.ScreenUpdating = False
For Each c In Range("E2", Range("E" & Rows.Count).End(xlUp))
  H = c
  For a = 1 To Len(H)
    If Not IsNumeric(Mid(H, a, 1)) Then
      Select Case Mid(LCase(H), a, 1)
        Case "a", "j", "s"
          Mid(H, a, 1) = "1"
        Case "b", "k", "t"
          Mid(H, a, 1) = "2"
        Case "c", "l", "u"
          Mid(H, a, 1) = "3"
        Case "d", "m", "v"
          Mid(H, a, 1) = "4"
        Case "e", "m", "w"
          Mid(H, a, 1) = "5"
        Case "f", "o", "x"
          Mid(H, a, 1) = "6"
        Case "g", "p", "y"
          Mid(H, a, 1) = "7"
        Case "h", "q", "z"
          Mid(H, a, 1) = "8"
        Case "i", "r"
          Mid(H, a, 1) = "9"
      End Select
    End If
  Next a
  c = H
Next c
Application.ScreenUpdating = True
End Sub

Then run the ReplaceAlphaV2 macro.

 

[Gos-C]

Perfect! Thanks a million, hiker95. I greatly appreciate your help.

Gos-C

 

[Gos-C]

For precautionary measures, may I have the results in column F, please.

Thank you,
Gos-C

 

[hiker95]

Gos-C,


Sample raw data:

Excel Workbook
	E	F
2	000000123456789
3	000000000F16520
4	000000TEST12345
5	000000000123XY9
6
Sheet1

After the macro:

Excel Workbook
	E	F
2	000000123456789	000000123456789
3	000000000F16520	000000000616520
4	000000TEST12345	000000251212345
5	000000000123XY9	000000000123679
6
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub ReplaceAlphaV3()
' hiker95, 03/28/2011
' http://www.mrexcel.com/forum/showthread.php?t=539183
Dim c As Range, a As Long, H As String
Application.ScreenUpdating = False
For Each c In Range("E2", Range("E" & Rows.Count).End(xlUp))
  H = c
  For a = 1 To Len(H)
    If Not IsNumeric(Mid(H, a, 1)) Then
      Select Case Mid(LCase(H), a, 1)
        Case "a", "j", "s"
          Mid(H, a, 1) = "1"
        Case "b", "k", "t"
          Mid(H, a, 1) = "2"
        Case "c", "l", "u"
          Mid(H, a, 1) = "3"
        Case "d", "m", "v"
          Mid(H, a, 1) = "4"
        Case "e", "m", "w"
          Mid(H, a, 1) = "5"
        Case "f", "o", "x"
          Mid(H, a, 1) = "6"
        Case "g", "p", "y"
          Mid(H, a, 1) = "7"
        Case "h", "q", "z"
          Mid(H, a, 1) = "8"
        Case "i", "r"
          Mid(H, a, 1) = "9"
      End Select
    End If
  Next a
  With c.Offset(, 1)
    .NumberFormat = "@"
    .Value = H
  End With
Next c
Columns(6).AutoFit
Application.ScreenUpdating = True
End Sub

Then run the ReplaceAlphaV3 macro.

 

[Gos-C]

Great! You are the best. Thank you very much, hiker95.

Robert, thanks for your response too.

Cheers,
Gos-C

 

[mikerickson]

This UDF might help, it can be used in a worksheet formula or in a macro as below.

Sub test()
    Dim oneCell As Range
    For Each oneCell In Range("E2", Range("E" & Rows.Count).End(xlUp))
        oneCell.Offset(0,1).Value = AlphaToNum(CStr(oneCell.Value))
    Next oneCell
End Sub

Function AlphaToNum(inString As String)
    Dim i As Long
    AlphaToNum = UCase(inString)
    For i = 1 To 26
        AlphaToNum = Replace(AlphaToNum, Chr(64 + i), ((i - 1) Mod 9) + 1)
    Next i
End Function

 

[Gos-C]

Thank you, mikerickson.

For both of you, mikerickson and hiker95: I want to automate the whole process by adding 678678 to each value and then multipling by 12. If you don't mind, can you put that in for me, please.

Also, for the benefit of myself and other users, mikerickson, can you explain the code - I understand hiker95's.

Thank you,
Gos-C

 

[mikerickson]

The code for the UDF I posted loops through the numbers 1-26.
On the first loop it replaces A with 1, throughout the string
on the second, it replaces B with 2
...
on the 9th loop, J is replaced with 1
....
until done.

My approach is more spreadsheet oriented than hiker95's. To do what you want, I'd put the formula =(AlphaToNum(E2) + 678678) * 2 in F2 and drag down.

If a macro is needed, I'd alter the macro Test rather than the UDF AlphaToNum.