Reference Numbers in a Text Box VBA

[bvokey]

Hello,

I am trying to reference a certain word or number in a text box and assign a variable to it. From this variable I want to adjust the height of an object.
For example, in the text box if I enter "Object height is 300 meters" or "Object height is 350.9 m" I want the macro to find 300 (350.9 in 2nd ex.) and then assign it to a variable. Is this possible?

Thanks.

 

[skorpionkz]

Is it Text Box or Insertox in VBA?

 

[bvokey]

Text Box, the user should be able to enter a value themself.

 

[skorpionkz]

Is there only 1 text box? and if it always going to be 1 number only in the text?

 

[bvokey]

Well no, there were be multiple, but each text box will control a different object. And no, in most instances there will be more than one number in the text box. If it helps though it would be acceptable to have an "@" in front of the number which I want to reference. For ex. "Object @ 300m".

 

[skorpionkz]

to make it clear, so it always will have @ before the number you want to extract and only before that number?

 

[bvokey]

Yes!

 

[skorpionkz]

EDIT: try this (corrected version)

Option Explicit
Sub theCode()
Dim strNum As String
Dim i As Long
With ActiveSheet.Shapes
For i = 1 To .Count
    If .Item(i).Type = msoTextBox Then
        strNum = .Item(i).TextFrame.Characters.Text
        ExtractNumber (strNum)
    
    End If
Next i
End With
 
End Sub

Function ExtractNumber(ByVal strNum As String) As Double
Dim i As Integer, iFirst As Integer, iLast As Integer

For i = 1 To Len(strNum)
    If IsNumeric(Mid(strNum, i, 1)) Then
        If iFirst = Empty Then
            iFirst = i
        Else
            iLast = i
        End If
    Else
        If Not iLast = Empty Then Exit For
    End If
Next i
ExtractNumber = Mid(strNum, iFirst, iLast - iFirst + 1)
End Function

 

[skorpionkz]

Sorry above code didn't take into account the decimal places and eventual commas after thousands. Please see adjusted below.

Option Explicit
Sub theCode()
Dim strNum As String
Dim i As Long
With ActiveSheet.Shapes
For i = 1 To .Count
    If .Item(i).Type = msoTextBox Then
        strNum = .Item(i).TextFrame.Characters.Text
        ExtractNumber (strNum)
    
    End If
Next i
End With
 
End Sub

Function ExtractNumber(ByVal strNum As String) As Double
Dim dNum As Double
Dim i As Integer, iFirst As Integer, iLast As Integer

For i = 1 To Len(strNum)
    If IsNumeric(Mid(strNum, i, 1)) Or Mid(strNum, i, 1) = "." Or Mid(strNum, i, 1) = "," Then
        If iFirst = Empty Then
            iFirst = i
        Else
            iLast = i
        End If
    Else
        If Not iLast = Empty Then Exit For
    End If
Next i
ExtractNumber = Mid(strNum, iFirst, iLast - iFirst + 1)
End Function

 

[bvokey]

Worked like a charm, thank you so much!