Share via

Macro to removes letters or symbols from a cell value when the value is entered?

Anonymous
2011-06-27T14:39:36+00:00

The spreadsheet I'm making will involve people copying and pasting information into certain columns, however the data source they will be using sometimes contains letters or symbols that creates a problem for other calculations on the sheet. I was wondering if it was possible to run a macro upon the entry of data in a cell to remove all characters except for numbers.

I've been using the following macro to remove letters so far:

Sub RemoveLetters()

Dim i As Long

For i = 32 To 41

    Selection.Replace what:=Chr(i), replacement:="", LookAt:=xlPart, SearchOrder:= _

       xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Next i

Selection.Replace what:="~*", replacement:="", LookAt:=xlPart, SearchOrder:= _

       xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

For i = 43 To 47

    Selection.Replace what:=Chr(i), replacement:="", LookAt:=xlPart, SearchOrder:= _

       xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Next i

For i = 58 To 62

    Selection.Replace what:=Chr(i), replacement:="", LookAt:=xlPart, SearchOrder:= _

       xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Next i

Selection.Replace what:="~?", replacement:="", LookAt:=xlPart, SearchOrder:= _

       xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

For i = 64 To 96

    Selection.Replace what:=Chr(i), replacement:="", LookAt:=xlPart, SearchOrder:= _

       xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Next i

For i = 123 To 125

    Selection.Replace what:=Chr(i), replacement:="", LookAt:=xlPart, SearchOrder:= _

       xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Next i

Selection.Replace what:="~~", replacement:="", LookAt:=xlPart, SearchOrder:= _

       xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

End Sub

Is there a way to run this macro every time data is entered or changed in a specific range (in my case columns B and C) ? Or maybe a better solution would be to have Excel ignore letters or special characters altogether, eliminating the need to exclude non-numeric characters. I would greatly appreciate any solution or help whatsoever.

Microsoft 365 and Office | Excel | For home | Windows

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments

Answer accepted by question author

  1. Anonymous
    2011-06-27T15:24:22+00:00

    You can automate your process with the Worksheet_Change function. Right click the name tab of your worksheet and select View Code. Paste this into the window titled something like Book1 - Sheet1 (Code),

    Private Sub Worksheet_Change(ByVal Target As Range)

        If Not Intersect(Target, Range("B2:E10")) Is Nothing Then

            For Each Cell In Target

                If Not Cell.HasFormula Then

                    iResult = ""

                    For i = 1 To Len(Cell.Value)

                        n = Asc(Mid(Cell.Value, i, 1))

                        If n > 47 And n < 58 Then

                            iResult = iResult & Chr(n)

                        End If

                    Next

                    Cell.Value = CLng(iResult)

                End If

            Next Cell

        End If

    End Sub

    Make any adjustment ot the range found in the second line. This should represent the area you want this routine to react upon if any or all cells in that range change in value. Press Alt+Q when you are satisfied with the code.

    With this routine in place, either manually editing or pasting in values should strip the values of all non-numeric characters.

    Note that I omitted the decimal point (e.g. Chr(46)) in retrieval. Post back if you require decimal numbers. I also allowed for formulas to be input without change.

    0 comments

Answer accepted by question author

  1. HansV 462.6K Reputation points MVP Volunteer Moderator
    2011-06-27T15:07:10+00:00

    Right-click the sheet tab.

    Select View Code from the context menu.

    Copy the following code into the code window that appears:

    Private Sub Worksheet_Change(ByVal Target As Range)

      Dim i As Long

      Dim rng As Range

      Set rng = Intersect(Range("B:C"), Target)

      If Not rng Is Nothing Then

        Application.ScreenUpdating = False

        For i = 32 To 41

          rng.Replace What:=Chr(i), Replacement:="", LookAt:=xlPart, SearchOrder:= _

            xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

        Next i

        rng.Replace What:="~*", Replacement:="", LookAt:=xlPart, SearchOrder:= _

          xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

        For i = 43 To 47

          rng.Replace What:=Chr(i), Replacement:="", LookAt:=xlPart, SearchOrder:= _

            xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

        Next i

        For i = 58 To 62

          rng.Replace What:=Chr(i), Replacement:="", LookAt:=xlPart, SearchOrder:= _

            xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

        Next i

        rng.Replace What:="~?", Replacement:="", LookAt:=xlPart, SearchOrder:= _

          xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

        For i = 64 To 96

          rng.Replace What:=Chr(i), Replacement:="", LookAt:=xlPart, SearchOrder:= _

            xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

        Next i

        For i = 123 To 125

          rng.Replace What:=Chr(i), Replacement:="", LookAt:=xlPart, SearchOrder:= _

            xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

        Next i

        rng.Replace What:="~~", Replacement:="", LookAt:=xlPart, SearchOrder:= _

          xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

        Application.ScreenUpdating = True

      End If

    End Sub

    Somebody will probably post a more efficient solution, so stay tuned.

    0 comments

0 additional answers

Sort by: Most helpful
Most helpful Newest Oldest