VBA, remove all characters within a string, except numerical characters and full stops

[rain4u]

I'm after a code that would remove all characters within a string that are not numbers (1234567890) and aren't full stops (.)


So lets say I have a string of text "ts [$11.40 USD]" (without quotes) in col F
Then after I would run the macro, it would only leave "11.40"
I'm looking for an easy and efficient code.

I have piece of code below that replaces "]" with blanks "". That is just an example that I would like to replace with something as described above.
Any help is very much appreciated. Any ideas?

Sub simple_test()
For r = 2 To 30

'the line below replaces "]" with blanks e.i. ""
Sheets("Sheet1").Range("G" & r) = Replace(Sheets("Sheet1").Range("G" & r), "]", "")

Next r:
End Sub

[Parth007]

Hey Rain,

I have this Link stored..

http://www.mrexcel.com/forum/excel-q...haracters.html
1. Remove Numeric characters
2. Remove Alphabetic characters
3. Remove Non-Numeric characters
4. Remove Non Alphabetic characters
5. Remove Non Alpha-Numeric characters
6. Remove Unprintable characters

Check if this may help you in advance... as a Quick

[rain4u]

Hey Parth
Thank you for the link. I had a look of the link that you gave me, and played around with some codes but I could not achieve a code that it would only keep numbers and full stops. This one is pretty difficult to figure out....

Though I'm sure somebody probably knows a genius way or has a out of the box thinking to achieve this. Any suggestions and ideas are very much welcome.

[shg]

Maybe ...

Sub r4u()
  Dim r             As Range
  Dim cell          As Range
  Dim i             As Long
  Dim sInp          As String
  Dim sOut          As String

  On Error Resume Next
  Set r = ActiveWindow.RangeSelection.SpecialCells(xlCellTypeConstants, xlTextValues)
  If Not r Is Nothing Then
    For Each cell In r
      sInp = cell.Value
      sOut = ""
      For i = 1 To Len(sInp)
        Select Case Mid(sInp, i, 1)
          Case "0" To "9", "."
            sOut = sOut & Mid(sInp, i, 1)
        End Select
      Next i
      cell.Value = sOut
    Next cell
  End If
End Sub

[rain4u]

Beatiful piece of code. It works like a charm. As I'm still learning and want to get better, can I leave some comments inside the code in terms of how I understand it. Am I more or less understanding it correctly?

Sub r4u()
  Dim r             As Range
  Dim cell          As Range
  Dim i             As Long
  Dim sInp          As String
  Dim sOut          As String

  On Error Resume Next
'---vvv---------------Sets the range i.e. currently selected range, only the cells that contain text
  Set r = ActiveWindow.RangeSelection.SpecialCells(xlCellTypeConstants, xlTextValues)

'---vvv---------------if cell contains text then
   If Not r Is Nothing Then
    For Each cell In r
'---vvv---------------gets the string value from cell
      sInp = cell.Value
      
'---vvv---------------sets the string sOut value to blank
      sOut = ""
      
'---vvv---------------gets the number of characters in a particular string and then starts to loop through each character
      For i = 1 To Len(sInp)

'---vvv---------------embarrasing to say but I'm not really familiar how "select Case" works. After all these years I stil have not learned to use case

'But effectivelly it loops through all the characteres within the original string
        Select Case Mid(sInp, i, 1)

'---vvv---------------if the character is between number 0 - 9 or "." then the code ads these characters to our new string
' Other characters  simply get ignored and wont be part of the new string.
          Case "0" To "9", "."
            sOut = sOut & Mid(sInp, i, 1)
        End Select
      Next i
      
'---vvv-----------------end result
      cell.Value = sOut
    
    Next cell
  End If
End Sub

[apo]

Here's another one to try..

I have assumed (as you showed in your example).. that there is only one instance of the the xx.xx in each cell...

Private Sub CommandButton1_Click()
    Dim x As Object, y, z, i As Long
    With CreateObject("VBScript.Regexp")
        .Pattern = "(\d+\.\d+)"
        y = Application.Transpose(Range("A1", Range("A" & Rows.Count).End(xlUp)))
        ReDim z(1 To UBound(y))
        For i = 1 To UBound(y)
            If .test(y(i)) Then
                Set x = .Execute(y(i))
                z(i) = x(0)
            End If
        Next i
    End With
    [B1].Resize(UBound(z)).Value = Application.Transpose(z)
End Sub

[shg]

Am I more or less understanding it correctly?

Yup, you got it.