How do I remove the characters? - vba

Question

How do I remove special characters and alphabets in a string ?
qwert1234*90)! ' this might be my cell value
I have to convert it to
123490 ' I mean I have to remove everything but keep only the numbers in string
but it should allow spaces !
qwe123 4567*. 90 ' String with spaces
123 4567 90 ' output should be
I found the vba Replace - but writing a replace for each character makes my code big. Well let me tell you clearly without hiding anything from you:
input: qwe123 4567*. 90 ' String with spaces cells(1,"A").value
My idea to do these next: 123 4567 90 ' remove characters first keeping white spaces
final output in A1:A3
123
4567
90
(for every space it should insert row and fill that)
Could you tell me how do remove all characters except numbers and spaces in string?
Thanks In advance

Answer 1

You need to use a regular expression.
See this example:
Option Explicit
Sub Test()
Const strTest As String = "qwerty123 456 uiops"
MsgBox RE6(strTest)
End Sub
Function RE6(strData As String) As String
Dim RE As Object, REMatches As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.MultiLine = False
.Global = True
.IgnoreCase = True
.Pattern = "([0-9]| )+"
End With
Set REMatches = RE.Execute(strData)
RE6 = REMatches(0)
End Function
Explanation:
Pattern = "([0-9]| )+" will match any 0 or more group (+) containing a number ([0-9]) or (|) a space ().
Some more info on the regexp:
a thread on ozgrid
a very good reference about regexp

Answer 2

Non-re alternative;
Public Function fmt(sValue As String) As String
Dim i As Long
For i = 1 To Len(sValue) '//loop each char
Select Case Mid$(sValue, i, 1) '//examine current char
Case "0" To "9", " " '//permitted chars
'//ok
Case Else
Mid$(sValue, i, 1) = "!" '//overwrite char in-place with "!"
End Select
Next
fmt = Replace$(sValue, "!", "") '//strip invalids & return
End Function
For:
?fmt("qwe123 4567*. 90")
123 4567 90

Answer 3

Those two funny codes will do both of your whishes..
Sub MySplitter(strInput As String)
Row = 10 ' Start row
Col = "A" ' Column Letter
Range(Col & Row) = "" ' Clean the start cell
For i = 1 To Len(strInput) ' Do with each Character in input string...
c = Mid(strInput, i, 1) ' Get actual char
If IsNumeric(c) Then Range(Col & Row) = Range(Col & Row) & c ' If numeric then append to actual cell
If (c = " ") And (Range(Col & Row) <> "") Then 'If space and actual row is not empty then...
Row = Row + 1 ' Jump to next row
Range(Col & Row) = "" ' Clean the new cell
End If
Next
End Sub
Function KeepNumbersAndSpaces(ByVal strInput As String)
For i = 1 To Len(strInput) ' Do with each Character in input string...
c = Mid(strInput, i, 1) ' Get actual char
If IsNumeric(c) Or c = " " Then ' If numeric or a space then append to output
KeepNumbersAndSpaces = KeepNumbersAndSpaces & c
End If
Next
End Function
Sub Test()
strInput = "qwert1234*90)! qwe123 4567*. 90"
MySplitter (strInput)
Range("A5") = KeepNumbersAndSpaces(strInput)
End Sub

Answer 4

Something like this to
split the string using a regexp
place the matches into an array
dump the array to an automatically sized spreadsheet range
main sub
Sub CleanStr()
Dim strOut As String
Dim Arr
strOut = Trim(KillChar("qwe123 4567*. 90 "))
Arr = Split(strOut, Chr(32))
[a1].Resize(UBound(Arr) + 1, 1) = Application.Transpose(Arr)
End Sub
function
Function KillChar(strIn As String) As String
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.Pattern = "[^\d\s]+"
KillChar = .Replace(strIn, vbNullString)
End With
End Function