Code is not giving correct output

Shweta

Well-known Member
Joined
Jun 5, 2011
Messages
514
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
 

Some videos you may like

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

ashish koul

Board Regular
Joined
Dec 30, 2010
Messages
56
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
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,400
Office Version
  1. 365
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,127,606
Messages
5,625,767
Members
416,136
Latest member
senthil_sk

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Top