Extracting multiple numbers from an excel cell having long description.

[adityabhatt1989]

Hello Everyone:

I am new to MrExcel.com forums and this is my first post here.

I need to extract numbers from excel cells. For eg-

BAR TBG 04.00X02.25X26.50 1340 HRN SMLS SPEC. ES4.38694 ^^^ This is one of the cells. I need to pull out 04.00, 2.25, 26.50, 1340 into different cells from one given cell. I have tried using =MID() function, but I need to make changes into that formula everytime the position of first numeric letter changes while I go along a column. And I need to make changes into it as I go along the row. It is taking me a lot of time in extracting numbers from one cell into different cells and I am afraid that I will spend the rest of my life getting this stuff done. Any help with this task is hugely appreciated and acknowledged. PS- There might already be a discussion thread on this. Posting that here would he helpful too. Best Aditya Bhatt

<tbody>
</tbody>

 

[Taisho]

Here is a version with 3rd additional example displaying correctly:

Option Explicit
Sub hehe()
Dim i As Integer, j As Integer, numstart As Integer, numend As Integer, k As Integer
Dim toextract As String, char As String, sheetname As String
Dim thelastrow As Long, iRow As Long
Dim v As Variant
sheetname = "Arkusz1"
thelastrow = ThisWorkbook.Sheets(sheetname).Cells.Find(What:="*", After:=[A1], LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
        MatchCase:=False, SearchFormat:=False).Row
        
v = ThisWorkbook.Sheets(sheetname).Range("a1:a" & thelastrow)
For iRow = LBound(v) To UBound(v)
k = 0
    toextract = v(iRow, 1)
    
    For i = 1 To Len(toextract)
        char = Mid(toextract, i, 1)
        If IsNumeric(char) = True Then
        
        numstart = i
        
            For j = i To Len(toextract)
                char = Mid(toextract, j, 1)
                    
                If IsLetter(char) = True And char <> "X" Then
                    i = j
                    Exit For
                End If
                
                If IsNumeric(char) = False And char <> "." Then
                    numend = j - 1
                    k = k + 1
                    Cells(iRow, k + 1) = Mid(toextract, numstart, numend - numstart + 1)
                    i = numend
                    Exit For
                End If
                
            Next j
            
        End If
    Next i
    
Next iRow
End Sub
Function IsLetter(strValue As String) As Boolean
    Dim intPos As Integer
    For intPos = 1 To Len(strValue)
        Select Case Asc(Mid(strValue, intPos, 1))
            Case 65 To 90, 97 To 122
                IsLetter = True
            Case Else
                IsLetter = False
                Exit For
        End Select
    Next
End Function

 

[Taisho]

Hello Taisho:

This seems interesting!

Forgive me for my ignorance but where do I have to go and run this code?

Thanks
Aditya

You need developer tools tab that is not default and requires files -> options > ribbon adjustment (or how it's called in eng version). You can go Developer tab -> macros, create one and name it, edit newly created macro and paste the code then run the macro by going to macros, selecting this one and pressing "run", you can also go to options for this macro and create ctrl + something (i'm always using ctrl+m) shortcut for running it so that you have a quick access to it. Alternatively you can go Developer tab ->insert -> from activex formants combobox, right click it, go to code and paste it. You will need to change "Sub hehe()" to "Private Sub CommandButton1_Click()".

 

[adityabhatt1989]

It gives me this error:

Runtime error '9'
Subscript out of range

 

[adityabhatt1989]

Its either the above error or the one below:

Runtime error'-2147352565 (8002000b)'
The item with specified name wasn't found

andd then this text gets highlighted in yellow-

thelastrow = ThisWorkbook.Sheets(sheetname).Cells.Find(What:="*", After:=[A1], LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
MatchCase:=False, SearchFormat:=False).Row

 

[Taisho]

sheetname = "Arkusz1"

You have to replace "Arkusz1" with name of sheet that you are using for example "Sheet1".

 

[adityabhatt1989]

sheetname = "Arkusz1"

You have to replace "Arkusz1" with name of sheet that you are using for example "Sheet1".

I did.
And still it gave the same error message:

Runtime error'-2147352565 (8002000b)'
The item with specified name wasn't found

This is the text that gets highlighted:

thelastrow = ThisWorkbook.Sheets(sheetname).Cells.Find(What:="*", After:=[A1], LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
MatchCase:=False, SearchFormat:=False).Row

 

[Taisho]

To be honest I don't know why this happens, try the following: save your excel file as .xlsm and check if it works, if it still doesn't let us know what operating system and excel version you are using and paste your whole code here so that we can make sure there are no mistakes with changing / wrong pasting the code.

 

[Taisho]

After entering wrong sheet name in the code I'm now completely sure this is the cause of the problem because it gives me identical error you have.