VBA to edit excel column of data - regex

Question

I have a requirement to edit a column of data where each cell has to be edited to remove all non-numeric characters. The only data that I need are actual numbers and a decimal point if one was there originally. I found a piece of code that removes everything with the exception of a "%" character. If someone could look at the code below and let me know how to modify it I would be appreciative. Examples of the type of data I am editing are as follows Complete cell contents enclosed in quotes). "3" "2.5%" "17 nks" "3.00 %" "4 VNS"
Here's the code I have used;
Sub RemoveAlphas()
'' Remove alpha characters from a string.
Dim intI As Integer
Dim rngR As Range, rngRR As Range
Dim strNotNum As String, strTemp As String
Set rngRR = Selection.SpecialCells(xlCellTypeConstants, _
xlTextValues)
For Each rngR In rngRR
strTemp = ""
For intI = 1 To Len(rngR.Value)
If Mid(rngR.Value, intI, 1) Like "[0-9,.]" Then
strNotNum = Mid(rngR.Value, intI, 1)
Else: strNotNum = ""
End If
strTemp = strTemp & strNotNum
Next intI
rngR.Value = strTemp
Next rngR
End Sub
Thanks.

Answer 1

This can be done using Regex as shown below- Have tested with your exact sample data and works for me:
Sub RemoveAlphas()
'' Remove alpha characters from a string.
Dim intI As Integer
Dim rngR As Range, rngRR As Range
Dim strNotNum As String, strTemp As String
Dim RegEx As Object
Set rngRR = Selection.SpecialCells(xlCellTypeConstants, _
xlTextValues)
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Global = True
RegEx.Pattern = "[^\d.]+"
For Each rngR In rngRR
rngR.Value = RegEx.Replace(rngR.Value, "")
Next rngR
End Sub

Answer 2

If you are getting the results you need with the exception of a percent sign, you can insert into this part of your code a Replace function:
Next intI
strTemp = Replace(strTemp, "%", "") 'Remove the % sign and replace with nothing.
rngR.Value = strTemp
Next rngR

Answer 3

Try the RexExp below which builds on my code from Remove non-numeric characters from a range of cells, and uses variant arrays for speed.
The RegExp pattern is [^\d\.]+
Sub KillNonNumbers()
Dim rng1 As Range
Dim rngArea As Range
Dim lngRow As Long
Dim lngCol As Long
Dim lngCalc As Long
Dim objReg As Object
Dim X()
On Error Resume Next
Set rng1 = Selection.SpecialCells(xlCellTypeConstants, xlTextValues)
If rng1 Is Nothing Then Exit Sub
On Error GoTo 0
'See Patrick Matthews excellent article on using Regular Expressions with VBA
Set objReg = CreateObject("vbscript.regexp")
objReg.Pattern = "[^\d\.]+"
objReg.Global = True
'Speed up the code by turning off screenupdating and setting calculation to manual
'Disable any code events that may occur when writing to cells
With Application
lngCalc = .Calculation
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
'Test each area in the user selected range
'Non contiguous range areas are common when using SpecialCells to define specific cell types to work on
For Each rngArea In rng1.Areas
'The most common outcome is used for the True outcome to optimise code speed
If rngArea.Cells.Count > 1 Then
'If there is more than once cell then set the variant array to the dimensions of the range area
'Using Value2 provides a useful speed improvement over Value. On my testing it was 2% on blank cells, up to 10% on non-blanks
X = rngArea.Value2
For lngRow = 1 To rngArea.Rows.Count
For lngCol = 1 To rngArea.Columns.Count
'replace the leading zeroes
X(lngRow, lngCol) = objReg.Replace(X(lngRow, lngCol), vbNullString)
Next lngCol
Next lngRow
'Dump the updated array sans leading zeroes back over the initial range
rngArea.Value2 = X
Else
'caters for a single cell range area. No variant array required
rngArea.Value = objReg.Replace(rngArea.Value, vbNullString)
End If
Next rngArea
'cleanup the Application settings
With Application
.ScreenUpdating = True
.Calculation = lngCalc
.EnableEvents = True
End With
Set objReg = Nothing
End Sub