vba find first set of numbers in a string ignoring any subsequent

[Trebor8484]

Hi,

I'm looking for a solution to the following issue please.

I am importing data into excel from a web application where some of the data is in "free text" format.

I am trying to extract the first group of numeric values from a string, so for example cell in cell A1 if the value is something like "Hello, my name is Scott and I live at 123 Maiden Road, I've lived here for the last 23 years" - so in this I would need to see 123 in the adjacent cell, ignoring the "23" part of the string.

I know this could probably be done with a formula, but a vba solution would be better so I can include it with the rest of my project.

Thanks

 

[DanteAmor]

I've just ran this on 10,000 lines of data and haven't come accross any issue yet, but I would like to cover for any eventuality. A UDF is fine now I know how to call it in my sub.

How about this. Using the above functions and in case of having the eventuality mentioned by @Rick "12e3"

Sub extnum3()
    Dim c As Range, n As Long, j As Long
    For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        n = Evaluate("=min(FIND({0,1,2,3,4,5,6,7,8,9}," & c.Address & "&""0123456789""))")
        If n = Len(c) Then
            c.Offset(0, 1).Value = Mid(c, n)
        Else
            For j = n + 1 To Len(c)
                If Mid(c, j, 1) Like "*[!0-9]*" Then
                    c.Offset(0, 1).Value = Mid(c, n, j - n)
                    Exit For
                End If
            Next
        End If
    Next
End Sub

 

[Rick Rothstein]

How about this. Using the above functions and in case of having the eventuality mentioned by @Rick "12e3"

Sub extnum3()
    Dim c As Range, n As Long, j As Long
    For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        n = Evaluate("=min(FIND({0,1,2,3,4,5,6,7,8,9}," & c.Address & "&""0123456789""))")
        If n = Len(c) Then
            c.Offset(0, 1).Value = Mid(c, n)
        Else
            For j = n + 1 To Len(c)
                If Mid(c, j, 1) Like "*[!0-9]*" Then
                    c.Offset(0, 1).Value = Mid(c, n, j - n)
                    Exit For
                End If
            Next
        End If
    Next
End Sub

You can simplify your code by substituting the "e" away...

Sub extnum3()
    Dim c As Range, n As Long, j As Long
    For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        n = Evaluate("=min(FIND({0,1,2,3,4,5,6,7,8,9}," & c.Address & "&""0123456789""))")
        c.Offset(, 1) = Val(Replace(Mid(UCase(c.Value), n), "E", "x"))
    Next
End Sub

 

[Rick Rothstein]

You can simplify your code by substituting the "e" away...

Sub extnum3()
    Dim c As Range, n As Long, j As Long
    For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        n = Evaluate("MIN(FIND({0,1,2,3,4,5,6,7,8,9}," & c.Address & "&""0123456789""))")
        c.Offset(, 1) = Val(Replace(Mid(UCase(c.Value), n), "E", "x"))
    Next
End Sub

Whoops! I forgot about "D" (does the same thing as "E" in the VB world)...

Sub extnum3()
    Dim c As Range, n As Long, j As Long
    For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        n = Evaluate("MIN(FIND({0,1,2,3,4,5,6,7,8,9}," & c.Address & "&""0123456789""))")
        c.Offset(, 1) = Val(Replace(Replace(Mid(UCase(c.Value), n), "E", "x"), "D", "x"))
    Next
End Sub

 

[DanteAmor]

You can simplify your code by substituting the "e" away...

Sub extnum3()
    Dim c As Range, n As Long, j As Long
    For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        n = Evaluate("=min(FIND({0,1,2,3,4,5,6,7,8,9}," & c.Address & "&""0123456789""))")
        c.Offset(, 1) = Val(Replace(Mid(UCase(c.Value), n), "E", "x"))
    Next
End Sub

If the "e" is what could eventually affect, then I guess that's it.

 

[Rick Rothstein]

If the "e" is what could eventually affect, then I guess that's it.

See Message #13 for an update on this.

 

[DanteAmor]

See Message #13 for an update on this.

If the "e" and "d" are what could eventually affect, then I guess that's it.


Otherwise, my code will solve it.

 

[DanteAmor]

How about:

"some text 12.1 some more"
Result:
12.1

With my last code
Result
12

 

[Rick Rothstein]

How about:

"some text 12.1 some more"
Result:
12.1

With my last code
Result
12

The OP will have to tell us if floating point numbers are to be permitted or not. If not, we can replace the dot as well.

 

[DanteAmor]

The OP will have to tell us if floating point numbers are to be permitted or not. If not, we can replace the dot as well.

Okay, I think that would be the last replacement.
Well, while, another improved version:

Sub extnum3()
    Dim c As Range, n As Long, j As Long
    For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        n = Evaluate("=min(FIND({0,1,2,3,4,5,6,7,8,9}," & c.Address & "&"" 0123456789""))")
        j = n + 1
        Do While Mid(c, j, 1) Like "*[0-9]*"
            j = j + 1
        Loop
        c.Offset(0, 1).Value = Mid(c, n, j - n)
    Next
End Sub

 

[Trebor8484]

The OP will have to tell us if floating point numbers are to be permitted or not. If not, we can replace the dot as well.

Hi, no floating point numbers, so 12.1 should be 12. Also if possible, is there a way of identifying cells that have multiple sets of numbers within the string? I would still need to output just the first set, but then a way of identifying any anomalies.