Know if the last char is a number

[cssfonseca]

Hello !

I need to know, in each cell in a range, if the last char of a cell is a number (the cell can contain text but i want to know only if the last char is a number), and if not, I want to show in a message box and highlight it.

I have written this code by adapting another code I have, and my attempt has been unsuccessful.

Sub verificarfinal()Dim c As Range
Dim Msg As String


For Each c In Range
    If IsNumeric(Right(c, 1)) Then
        Msg = Msg & vbTab & c.Address(RowAbsolute:=False, ColumnAbsolute:=False) & vbNewLine And c.Interior.ColorIndex = 3
    End If
If Len(Msg) > 0 Then MsgBox "Verifique se as medidas estão conformes na(s) célula(s)" & vbNewLine & Msg
End If
    Exit For
Next c
End Sub

Can u help me? Where did I go wrong? Everywhere?

 

[lrobbo314]

Bom dia!

Try this

Sub verificarfinal()
Dim c As Range
Dim r As Range
Dim Msg As String


Set r = Selection 'Can change to any range such as "A1:C20"
For Each c In r
    If IsNumeric(Right(c, 1)) Then
        c.Interior.ColorIndex = 3
        Msg = Msg & c.Address(RowAbsolute:=False, ColumnAbsolute:=False) & vbCrLf
    End If
Next c


If Msg <> vbNullString Then MsgBox "Verifique se as medidas estão conformes na(s) célula(s)" & vbNewLine & Msg
End Sub

 

[cssfonseca]

Thank you so much for your fast reply! It's working :D But I have a little problem that I didn't mention. I don't know the specific column. The user will specify it through an input box. How do I do that? I'm receiving the column on another macro. Should I join them or keep it separate?

Sub Dimensoes()

    Dim col As Variant
    Dim lr As Long
    Dim rng As Range
    Dim cell As Range
    Dim acode As Integer
    


    Application.ScreenUpdating = False
    
'   Prompt user to enter the column to apply this to
    
    col = InputBox("Por favor insira a Letra da coluna na qual pretende verificar as dimensões:")
    
    'se for número
    If Not IsNumeric(col) = False Then
    MsgBox "O Valor inserido não é válido.", vbAbortRetryIgnore, "Opção inserida não válida"
    Else
    'se nao tiver nada
    If col = "" Then Exit Sub
    
    Sheets("Sheet1").Activate
'   Find last row in column
    lr = Cells(Rows.Count, col).End(xlUp).Row
    
'   Set rng to fix
    Set rng = Range(Cells(2, col), Cells(lr, col))


'   Replace values in range
    Application.DisplayAlerts = False
    ' correr trim
    
         rng.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, _
         SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        'em vez de substituir, apenas avisar que existem espaços
        
    rng.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        rng.Replace What:="X", Replacement:="x", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Application.DisplayAlerts = True


    
    Application.ScreenUpdating = True
    
    
    
    End If
    
    
End Sub

 

[lrobbo314]

How about this?

Public col As Variant


Sub Dimensoes()


    
    Dim lr As Long
    Dim rng As Range
    Dim cell As Range
    Dim acode As Integer
    




    Application.ScreenUpdating = False
    
'   Prompt user to enter the column to apply this to
    
    col = InputBox("Por favor insira a Letra da coluna na qual pretende verificar as dimensões:")
    
    'se for número
    If Not IsNumeric(col) = False Then
    MsgBox "O Valor inserido não é válido.", vbAbortRetryIgnore, "Opção inserida não válida"
    Else
    'se nao tiver nada
    If col = "" Then Exit Sub
    
    Sheets("Sheet1").Activate
'   Find last row in column
    lr = Cells(Rows.Count, col).End(xlUp).Row
    
'   Set rng to fix
    Set rng = Range(Cells(2, col), Cells(lr, col))




'   Replace values in range
    Application.DisplayAlerts = False
    ' correr trim
    
         rng.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, _
         SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        'em vez de substituir, apenas avisar que existem espaços
        
    rng.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        rng.Replace What:="X", Replacement:="x", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Application.DisplayAlerts = True




    
    Application.ScreenUpdating = True
    
    
    
    End If
    verificarfinal
    
End Sub


Sub verificarfinal()
Dim c As Range
Dim r As Range
Dim Msg As String


Set r = Range(col & 1 & ":" & col & Range(col & Rows.Count).End(xlUp).Row)
For Each c In r
    If IsNumeric(Right(c, 1)) Then
        c.Interior.ColorIndex = 3
        Msg = Msg & c.Address(RowAbsolute:=False, ColumnAbsolute:=False) & vbCrLf
    End If
Next c


If Msg <> vbNullString Then MsgBox "Verifique se as medidas estão conformes na(s) célula(s)" & vbNewLine & Msg
End Sub

 

[cssfonseca]

Thank you so much ! Perfect ! Now i can sleep hahahahaha
Have a great day !

 

[lrobbo314]

Tou feliz em ajudar