How to define if character in cell is number, letter or special character using VBA?

Question

I want to go through a column with a cells containing numbers, letters and other characters of different length, and classify in a second row sort the "template" of this cell.

Numbers should become "N", letters should become "L" and other characters should remain the same.

So e.g. if A1 contains "A35p@5" it the output in B1 should be "LNNL@N".

Here is my code so far, but it does only work for the first character. Also for other or special characters the output just continues to copy whatever is after the character. See output from my test case in Excel and VBA code below. What am I missing here?

Sub myMacro()

    'Define variables
    Dim char As String

    For I = 1 To Range("A10").End(xlUp).Row
        For J = 1 To Len(Range("A" & I))
            
            char = Left(Range("A" & I), J)
            
            If IsNumeric(char) Then
                Range("B" & I).Value = "N"
            ElseIf IsLetter(char) Then
                Range("B" & I).Value = "L"
            ElseIf IsSecialCharacter(char) Then
                Range("B" & I).Value = char
            End If
            
        Next J
    Next I
End Sub

Function IsLetter(r As String) As Boolean
    If r = "" Then Exit Function
    Dim x As Long
    x = Asc(UCase(r))
    IsLetter = (x > 64 And x < 91)
End Function

Function IsSecialCharacter(r As String) As Boolean
    If r = "" Then Exit Function
    Dim x As Long
    x = Asc(UCase(r))
    IsSecialCharacter = (x > 31 And x < 48) Or (x > 57 And x < 65) Or (x > 90 And x < 97) Or (x > 122 And x < 127)
End Function

Answer 1

Let's create a function to convert the text to the new format, with a Sub to run the loop. Then, let's strip Diacritics from letters, and use a Switch Statement to check if a character is Number, Letter, or Other: (Note that, if the character is neither Number nor Letter, we don't need to run an additional check to see if it is "anything else" — because, those are all that are left!)

Sub MyMacro()
    Dim rTMP As Range
    For Each rTMP In Range(Cells(1,1), Cells(Rows.Count,1).End(xlUp)).Cells
        rTMP.Offset(0,1).Value = TextToMask(rTmp.Value)
    Next rTMP
End Sub

Function TextToMask(Value As String) As String
    Const NumberValue AS String = "N"
    Const LetterValue AS String = "L"
    Const SymbolValue AS String = ""
    Dim i AS Long, CleanValue As String
    CleanValue = StripDiacritics(Value)

    If Len(Value)<1 Then Exit Function

    For i = 1 To Len(Value)
        Select Case Mid(CleanValue, i, 1)
            Case "0" To "9"
                TextToMask = TextToMask & Left(NumberValue & Mid(Value, i), 1)
            Case "A" To "Z", "a" To "z"
                TextToMask = TextToMask & Left(LetterValue & Mid(Value, i), 1)
            Case Else
                TextToMask = TextToMask & Left(SymbolValue & Mid(Value, i), 1)
        End Select
    Next i
End Function

Function StripDiacritics(Value As String) As Value
    'This will convert letters like "á" to "a", etc
    If Len(Value) < 1 Then Exit Function
    Dim i AS Long, Letters As Variant, Comparison As Variant
    Letters = Array("a","b","c","d","e","f","g","h","i","j","k","l","m", _
                    "n","o","p","q","r","s","t","u","v","w","x","y","z")
    
    For i = 1 To Len(Value)
        Comparison = Application.Match(Mid(Value, i, 1), Letters)
        
        If IsError(Comparison) Then
            StripDiacritics = StripDiacritics & Mid(Value, i, 1)
        Else
            StripDiacritics = StripDiacritics & Chr(Comparison - 1 + 
                IIF(Mid(Value, i, 1)=UCase(Mid(Value, i, 1)), Asc("A"), Asc("a")))
        End If
    Next i
End Function

Answer 2

Update to existing code

You should use MID instead of LEFT.

Option Explicit

Sub myMacro()

'Define variables
Dim char As String
Dim I As Long
Dim J As Long

    For I = 1 To Range("A10").End(xlUp).Row
        For J = 1 To Len(Range("A" & I))

            char = Mid(Range("A" & I), J, 1)

            If IsNumeric(char) Then
                Range("B" & I).Value = Range("B" & I).Value & "N"
            ElseIf IsLetter(char) Then
                Range("B" & I).Value = Range("B" & I).Value & "A"
            ElseIf IsSpecialCharacter(char) Then
                Range("B" & I).Value = Range("B" & I).Value & char
            End If

        Next J
    Next I
End Sub

Function IsLetter(r As String) As Boolean
    If r = "" Then Exit Function
    Dim x As Long
    x = Asc(UCase(r))
    IsLetter = (x > 64 And x < 91)
End Function

Function IsSpecialCharacter(r As String) As Boolean
    If r = "" Then Exit Function
    Dim x As Long
    x = Asc(UCase(r))
    IsSpecialCharacter = (x > 31 And x < 48) Or (x > 57 And x < 65) Or (x > 90 And x < 97) Or (x > 122 And x < 127)
End Function

User defined function

Here's a UDF you could use.

Function Codify(strVal As String) As String
Dim ch As String
Dim I As Long

    If strVal = "" Then Exit Function

    For I = 1 To Len(strVal)
        ch = Mid(strVal, I, 1)

        If IsNumeric(ch) Then
            Codify = Codify & "N"
        ElseIf IsLetter(ch) Then
            Codify = Codify & "A"
        ElseIf IsSpecialCharacter(ch) Then
            Codify = Codify & ch
        End If
    Next I

End Function

Answer 3

I would strongly recommend that you install the free and fantastic RubberDuck add in for VBA.

Generally, in macros for Excel, you should try to minimise references into the excel object. i.e. bring the data into VBA, manipulate it in VBA and then put the result back into Excel. For a small number of references this probably isn't much of an issue, but as the range of inputs increases, the slowness of the access to the Excel object will make itself known.

Your code can be simplified greatly by making a few small changes. It can also be made much more readable by giving your variable more meaningful names

Please study the code below to see what I mean by the above.

Option Explicit

Public Const Letters                As String = "abcdefghijklmnopqrstuvwxyz"
Public Const Numbers                As String = "0123456789"
Public Const FoundLetter            As String = "L"
Public Const FoundNumber            As String = "N"

Public Sub Test()

    GenerateCharacterTemplates ActiveSheet
    
End Sub


Public Sub GenerateCharacterTemplates(ByVal ipSheet As Worksheet)

    Dim myRowIndex As Long
    For myRowIndex = 1 To ipSheet.Range("A10").End(xlUp).Row
    
        Dim myString As String
        ' Ensure that numbers can be processed as strings
        myString = LCase$(CStr(ipSheet.Range("A" & myRowIndex).Value))
        
        Dim myStringIndex As Long
        Dim myResult As String
        myResult = vbNullString
        For myStringIndex = 1 To Len(myString)

            Dim myChar As String
            myChar = Mid$(myString, myStringIndex, 1)

            Dim myClassification As String
            
            If IsNumber(myChar) Then
            
                myClassification = FoundNumber
                
                
            ElseIf IsLetter(myChar) Then
            
                myClassification = FoundLetter
                
                
           Else
           
                myClassification = myChar
                
                
            End If
            
            myResult = myResult & myClassification
            

        Next myStringIndex
        
        ipSheet.Range("B" & CStr(myRowIndex)).Value = myResult
        
        
    Next myRowIndex
    
End Sub

Public Function IsLetter(ByVal ipChar As String) As Boolean

    If ipChar = vbNullString Then Exit Function
    IsLetter = InStr(Letters, ipChar) > 0
    
End Function

Public Function IsNumber(ByVal ipChar As String) As Boolean

    If ipChar = vbNullString Then Exit Function
    IsNumber = InStr(Numbers, ipChar) > 0
    
End Function

The code above produces the following

1C31    NLNN
C223    LNNN
34D     NNL
G4h/    LNh/
145     NNN
    
V       L
8       N
)K      )L

Answer 4

Nice question and query. I took some time to give you a few options:

---

1) Microsoft 365 dynamic array functionality:

If you have Microsoft365, you could use:

Formula in B1:

=IFERROR(LET(X,MID(A1,SEQUENCE(LEN(A1)),1),CONCAT(IF(ISNUMBER(X*1),"N",IF(ISNUMBER(FIND(UPPER(X),"ABCDEFGHIJKLMNOPQRSTUVWXYZ")),"L",X)))),"")

---

2) Excel VBA - Like() operator:

Hereby a VBA routine that will loop every character in each string and compares it through the Like() operator:

Sub Test()

Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
Dim lrow As Long, x As Long, i As Long, arr As Variant
Dim char As String, tmp As String, full As String

lrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
arr = ws.Range("A1:B" & lrow).Value
For x = LBound(arr) To UBound(arr)
    If Len(arr(x, 1)) > 0 Then
        full = ""
        For i = 1 To Len(arr(x, 1))
            char = Mid(arr(x, 1), i, 1)
            If char Like "[!A-Za-z0-9]" Then
                tmp = char
            ElseIf char Like "#" Then
                tmp = "N"
            Else
                tmp = "L"
            End If
            full = full & tmp
        Next
        arr(x, 2) = full
    End If
Next
ws.Range("A1:B" & lrow).Value = arr

End Sub

---

3) Excel VBA - Regexp object:

Whilst Like() operator looks like a regular expression, it isn't quite the same. We could however also make use of a 'RegeXp' object:

Sub Test()

Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
Dim lrow As Long, x As Long, arr As Variant

lrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
arr = ws.Range("A1:B" & lrow).Value

With CreateObject("VBScript.RegExp")
    .Global = True
    For x = LBound(arr) To UBound(arr)
        .Pattern = "[a-zA-Z]"
        arr(x, 2) = .Replace(arr(x, 1), "L")
        .Pattern = "\d"
        arr(x, 2) = .Replace(arr(x, 2), "N")
    Next
End With

ws.Range("A1:B" & lrow).Value = arr

End Sub