Solved: find number in string

[kroz]

hey all,

I have a rather fine tunning question for you. Can you guys come up with a faster code (as in less time consuming) then this one? I'm trying to find the number in a column of strings, the values can be one of the following:

S***NUMBER
S**number
S*number

I've added an extra precaution to check for the fifth char too because there may be values that i haven't found yet. This is the code i got:


If IsNumeric(Mid(.Value, 5, 1)) Then
If IsNumeric(Mid(.Value, 4, 1)) Then
If IsNumeric(Mid(.Value, 3, 1)) Then
If IsNumeric(Mid(.Value, 2, 1)) Then
aLoc = 2
End If
Else
aLoc = 3
End If
Else
aLoc = 4
End If
Else
aLoc = 5
End If
aTemp = Right(.Value, Len(.Value) - aLoc)


This would extract my text but i'm wondering if going through so many loops can be avoided.

Thanx

P.S. The * are wildchars, combination of letters.

[Bob Phillips]

Use a formula, like this array formula

=MID(A2,MIN(IF(ISERROR(1*(MID(A2,ROW(INDIRECT("A2:A"&LEN(A2))),1))),
255,ROW(INDIRECT("A2:A"&LEN(A2))))),99)

[kroz]

You totally lost me with that formula but it works :) Thank you
P.S. You forgot to mention that i have to activate it with CTRL+SHIFT+ENTER :) but it works

[Tinbendr]

This assumes the numbers are in a named range called MyRange. It enters the result in the next column.

Sub ExtractNumber()
Dim aCell As Range
Dim A As Long
For Each aCell In Range("MyRange")
For A = 1 To Len(aCell)
Select Case Mid(aCell, A, 1)

Case 0 To 9
Cells(aCell.Row, 2) = Cells(aCell.Row, 2) & Mid(aCell, A, 1)

End Select
Next A
Next

End Sub

[Bob Phillips]

You totally lost me with that formula but it works :) Thank you
P.S. You forgot to mention that i have to activate it with CTRL+SHIFT+ENTER :) but it works

I did mention it was an array formula, that is what you have to do with array formulas.

[kroz]

I tried both formulas on my vba and found out that Tinbendr's formula is somewhat faster (i have over 4000 lines of data to go through). Thank you both for the help

[kemas]

to clear before executing code


Dim aCell As Range
Dim A As Long
Dim bCell As Range

Set myrng = Range("MyRange")
With myrng
For Each bCell In myrng
.Offset(0, 1).ClearContents
Next bCell
End With
For Each aCell In Range("MyRange")
For A = 1 To Len(aCell)
Select Case Mid(aCell, A, 1)

Case 0 To 9
Cells(aCell.Row, 2) = Cells(aCell.Row, 2) & Mid(aCell, A, 1)
End Select
Next A
Next

and thanks for this good code