# Code is not giving correct output

#### Shweta

##### Well-known Member
Hi All,

I am using the below code for extracting numbers from an alphanumeric text. But this is not giving the correct output. Please suggest what changes are required to make it work.

Code:
``````Sub extract_numbers()
Dim i As Integer
Dim j As Integer
Dim arr As Variant

arr = Application.Transpose(Sheet1.Cells(1, 1).CurrentRegion.Resize(, 1).Value)

For i = LBound(arr) To UBound(arr)

For j = 1 To Len(arr(i))

If IsNumeric(VBA.Mid(arr(i), j, 1)) Then

arr(i) = arr(i) & VBA.Mid(arr(i), j, 1)
End If

Next
Next

Sheet1.Cells(1, 2).Resize(UBound(arr), 1).Value = Application.Transpose(arr)
End Sub``````
Regards,
Shweta

### Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

#### ashish koul

##### Board Regular
see if it helps

Code:
``````Sub extract_numbers()
Dim i As Integer, j As Integer
Dim arr As Variant
Dim c As String
arr = Application.Transpose(Sheet1.Cells(1, 1).CurrentRegion.Resize(, 1).Value)
For i = LBound(arr) To UBound(arr)
c = ""

For j = 1 To Len(arr(i))

If IsNumeric(Mid(arr(i), j, 1)) Then
c = c & Mid(arr(i), j, 1)
End If

Next
arr(i) = c
Next
Sheet1.Cells(1, 2).Resize(UBound(arr), 1).Value = Application.Transpose(arr)
End Sub``````

#### Shweta

##### Well-known Member
Thanks Ashish! It's working.

#### Peter_SSs

##### MrExcel MVP, Moderator
Here's another approach to consider. It doesn't require manually looping through every character of every cell.
Code:
``````Sub Extract_Numbers_2()
Dim RX As Object
Dim arr As Variant
Dim i As Long
Dim s As String

Set RX = CreateObject("VBScript.RegExp")
RX.Global = True
RX.Pattern = "\D"
With Sheet1.Cells(1, 1).CurrentRegion.Resize(, 1)
arr = .Value
For i = 1 To UBound(arr, 1)
s = arr(i, 1)
arr(i, 1) = RX.Replace(s, "")
Next i
.Offset(, 1).Value = arr
End With
End Sub``````

Replies
6
Views
157
Replies
3
Views
229
Replies
2
Views
423
Replies
3
Views
124
Replies
5
Views
225

1,127,582
Messages
5,625,620
Members
416,124
Latest member
DeMoNloK

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back