VBA to remove numbers from start of string/cell

Question

I hope you can help.

I have a piece of code that is currently removing all the text from the cells in Column G. What I need is for this code to instead of removing the text I would like it to remove the numbers, and I only want it to remove the numbers at the beginning of the string/cell the rest of the data I would like to remain the same.

I have attached a picture PIC.1 for betting understanding.

PIC1

The code I currently have and I hope can be amended is below and as always any and all help is greatly appreciated.

CODE

Sub RemoveNonDigits()
  Dim X As Long, Z As Long, LastRow As Long, CellVal As String
  Const StartRow As Long = 1
  Const DataColumn As String = "G"
  Application.ScreenUpdating = False
  LastRow = Cells(Rows.Count, DataColumn).End(xlUp).Row
  For X = StartRow To LastRow
    CellVal = Cells(X, DataColumn)
    For Z = 1 To Len(CellVal)
      If Mid(CellVal, Z, 1) Like "[!0-9]" Then Mid(CellVal, Z, 1) = " "
    Next
    With Cells(X, DataColumn)
      .NumberFormat = "@"
      .Value = Replace(CellVal, " ", "")
    End With
  Next
  Application.ScreenUpdating = True
End Sub

Solution 1

See the modified code below:

Sub RemoveNonDigits()
  Dim X As Long, Z As Long, LastRow As Long, CellVal As String
  Const StartRow As Long = 1
  Const DataColumn As String = "G"
  Application.ScreenUpdating = False
  LastRow = Cells(Rows.Count, DataColumn).End(xlUp).Row
  For X = StartRow To LastRow
    CellVal = Cells(X, DataColumn)
    While IsNumeric(Left(CellVal, 1))   ' Here
      CellVal = Mid(CellVal, 2)         ' all digits at the start 
    Wend                                ' are removed
    Cells(X, DataColumn) = Trim(CellVal)
  Next
  Application.ScreenUpdating = True
End Sub

That is, while the starting char in CellVal is a digit, get the substring starting with the second char, and go on until no match.

Solution 2

CellVal = LTrimDigits(Cells(X, DataColumn))

With this fairly efficient:

Public Function LTrimDigits(value As String) As String
    Dim i As Long
    For i = 1 To Len(value) '//loop each char
        Select Case Mid$(value, i, 1) '//examine current char
            Case "0" To "9" '//permitted chars
            Case Else: Exit For '// i is the cut off point
        End Select
    Next
    LTrimDigits = Mid$(value, i) '//strip lead
End Function

Solution 3

A bit hacky shorter alternative (assuming all values start with integer)

For Each cell in Range([G7], [G7].End(xlDown))

    cell.Value2 = Trim(Mid(cell, Len(Str(Val(cell)))))

Next

Solution 4

This function will strip leading digits and spaces from a string

Function RemoveLeadingDigits(str As String) As String

    Dim i As Long
    Dim chr As String
    ' Loop through string
    For i = 1 To Len(str)
        ' Get character i
        chr = Mid(str, i, 1)
        ' Keep looping until character is not a number or space
        If Not IsNumeric(chr) And Not chr = " " Then
            ' If it is a number or space, strip checked characters
            ' from str (because they'll be numeric or space)
            str = Right(str, Len(str) - i + 1)
            ' Stop looping as non-numeric characters encountered
            Exit For
        End If
    Next i

    ' Return the value of str
    RemoveLeadingDigits = str

End Function

You can call it from your code by

Sub RemoveNonDigits()
    Dim X As Long, LastRow As Long, CellVal As String
    Const StartRow As Long = 1
    Const DataColumn As String = "G"
    Application.ScreenUpdating = False
    LastRow = Cells(Rows.Count, DataColumn).End(xlUp).Row
    For X = StartRow To LastRow
        CellVal = Cells(X, DataColumn).Value
        ' ----------------------------------------
        CellVal = RemoveLeadingDigits(CellVal)
        ' ----------------------------------------
    Next
    Application.ScreenUpdating = True
End Sub

A note on your code though:

You should really fully qualify your cells. For instance, wrap the whole looping section in With ThisWorkbook.Sheets("YourSheet") and then accessing cells using .Cells(row, col) rather than just Cells(row, col).

Solution 5

I think a simple change like this:

For X = StartRow To LastRow
    Cells(X, DataColumn).Formular1c1 = Application.Trim(Replace(Cells(X, DataColumn).Text, Val(Cells(X, DataColumn).Text), ""))
Next X

will solve your problem...

View more solutions