VBA - Remove all except numbers

[PaulMacF]

Hi there,

Realise this has been asked on here many times, but can't find a suitable solution for exactly what I need all the same -

Simply need to...
1/Remove everything except numbers from columns E:F
2/Fill any blank/empty cells in columns E:F with zeros's(0)
Needs to work down to the last populated row, no lower than that.

Thanks.

 

[JvdV]

Here is a formula that may help:

Question.xlsx
	E	F	G	H	I
1	111	4		111	4
2	134+	3R		134	3
3	135	2k		135	2
4	134	1		134	1
5		6		0	6
6	T6			6	0
Sheet8

Cell Formulas
Range	Formula
H1:I6	H1	=MAP(FILTER(E:F,E:E&F:F<>""),LAMBDA(x,0+(0&CONCAT(IFERROR(--MID(x,SEQUENCE(LEN(x)),1),"")))))
Dynamic array formulas.

 

[sadath]

=MAP(YourDataRangeHere,LAMBDA(x,TEXTJOIN("",TRUE,IFERROR(--MID(x,SEQUENCE(10),1),""))*1))

 

[James006]

Hi,
You can test following macro

Sub LoopThroughRange()
Dim rng As Range, c As Range
Dim i As Integer
' Adjust to your specific Range
Set rng = Range("E4:F10")
For Each c In rng
    For i = 1 To Len(c.Value)
        If Asc(Mid(c.Value, i, 1)) < 48 Or Asc(Mid(c.Value, i, 1)) > 57 Then
            c.Value = Replace(c.Value, Mid(c.Value, i, 1), "")
        End If
    Next i
Next c
End Sub

 

[PaulMacF]

Thanks, couldn't get those to work. This did the trick.

Sub RemoveNotNum()
Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "RemoveText"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
For Each Rng In WorkRng
    xOut = ""
    For i = 1 To Len(Rng.Value)
        xTemp = Mid(Rng.Value, i, 1)
        If xTemp Like "[0-9]" Then
            xStr = xTemp
        Else
            xStr = ""
        End If
        xOut = xOut & xStr
    Next i
    Rng.Value = xOut
Next
End Sub