zzfloP
zzfloP

Reputation: 17

Highlight characters in cell that are not Latin or numbers

I have a column of codes that should only have numbers or Latin chars, but some of them may have been input incorrectly, that is some of them maybe Cyrillic or other. For example: РE09000047 or PE09000047.

I've got this code to work but it sees numbers as non-Latin:

Sub NonLatin()
Dim cell As Object
    For Each cell In Selection
        s = cell.Value
            For i = 1 To Len(s)
                If Mid(s, i, 1) Like "[0x0000-0x007F]" Then
                    cell.Interior.ColorIndex = 6
                    cell.Characters(i, l).Font.Color = vbRed
                    cell.Characters(i, l).Font.Bold = True
                End If
            Next
    Next
End Sub

It makes cell yellow, and non-Latin chars red and bolded. But also numbers. How can I make this work?

Upvotes: 2

Views: 95

Answers (2)

VBasic2008
VBasic2008

Reputation: 54757

Highlight Non-Alpha-Numerics

enter image description here

Sub HighlightNonAlphaNumerics()
    
    ' Define constants.
    
    Const PROC_TITLE As String = "Highlight Non-Alpha-Numerics"
    Const CHAR_PATTERN As String = "[!A-Za-z0-9]" ' not alpha-numeric
    Const CELL_COLOR As Long = vbYellow
    Const CHAR_COLOR As Long = vbRed
    Const MSG_YES As String = _
        "Cells containing non-alpha-numeric characters highlighted"
    Const MSG_NO As String = _
        "No cells containing non-alpha-numeric characters found"
     
    ' Validate the selection.
    
    ' Check if there is no selection.
    If Selection Is Nothing Then
        MsgBox "There is no selection (""Nothing"")!", _
            vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    ' Check if the selection is no range.
    If Not TypeOf Selection Is Range Then
        MsgBox "The selection (""" & TypeName(Selection) _
            & """) is not a range!", vbExclamation, PROC_TITLE
        Exit Sub
    End If
        
    ' Clear specific selection formats.
    
    Application.ScreenUpdating = False
    
    With Selection
        .Interior.ColorIndex = xlNone
        .Font.ColorIndex = xlAutomatic
        .Font.Bold = False
    End With
    
    ' Loop through the cells and format the matching characters
    ' and combine each cell that was formatted into a unioned range
    ' to be highlighted later.
    
    ' Declare additional variables.
    Dim crg As Range, cell As Range, Value As Variant, i As Long
    Dim S As String, Char As String
    Dim IsCellFound As Boolean, IsValueValid As Boolean, IsCharFound As Boolean
    
    ' Loop.
    For Each cell In Selection
        Value = cell.Value
        ' Exclude errors and blanks.
        If Not IsError(Value) Then
            If Len(Value) > 0 Then
                IsValueValid = True
            End If
        End If
        ' Format characters.
        If IsValueValid Then
            S = CStr(Value)
            For i = 1 To Len(S)
                Char = Mid(S, i, 1)
                If Char Like CHAR_PATTERN Then
                    cell.Characters(i, 1).Font.Color = CHAR_COLOR
                    cell.Characters(i, 1).Font.Bold = True
                    IsCharFound = True
                End If
            Next i
            IsValueValid = False ' reset
        End If
        ' Combine cells.
        If IsCharFound Then
            If IsCellFound Then
                Set crg = Union(crg, cell)
            Else
                Set crg = cell
                IsCellFound = True ' never reset
            End If
            IsCharFound = False ' reset
        End If
    Next cell
    
    ' Highlight the cells.
    
    If IsCellFound Then crg.Interior.Color = CELL_COLOR
    
    Application.ScreenUpdating = True
    
    ' Inform.
    
    MsgBox IIf(IsCellFound, MSG_YES, MSG_NO) & " in """ _
        & "'" & Selection.Worksheet.Name & "'!" & Selection.Address(0, 0) _
        & """" & IIf(IsCellFound, ".", "!"), _
        IIf(IsCellFound, vbInformation, vbExclamation), PROC_TITLE
    
End Sub

Upvotes: 3

Umut Yurdugül
Umut Yurdugül

Reputation: 61

You can use a different approach to check for non-Latin characters.

Sub NonLatin()
    Dim cell As Range
    Dim s As String
    Dim i As Integer
    Dim char As String
    For Each cell In Selection
        s = cell.Value
        For i = 1 To Len(s)
            char = Mid(s, i, 1)
            ' Check if the character is not a number and not a Latin letter
            If Not (char Like "[0-9]" Or char Like "[A-Za-z]") Then
                cell.Interior.ColorIndex = 6 ' Yellow background for the cell
                cell.Characters(i, 1).Font.Color = vbRed ' Red font for non-Latin characters
                cell.Characters(i, 1).Font.Bold = True ' Bold font for non-Latin characters
            End If
        Next i
    Next cell
End Sub

Try this, that should work i think.

Upvotes: 1

Related Questions