Extract numbers from string

[Anonymous]

I need to write a rule that will extract either one or two numbers from a string.

For example, the results from these string would be as follows:

Bar round 35.0mm x 3m mild steel

1. 35.0

Section box 30 x 30 x 3mm mild steel

1. 30
2. 30

Bar flat 80 x 8mm x 6.1m mild steel

1. 80
2. 8

Rod 5 mm x 3mt stainless steel grade 304

1. 5

Its essentially the first two numbers that are separated by an "x", but I'm thrown a curve ball when I only need one number returned.

The other issue I need to overcome is that the format is not always consistent, for example some entries:

• may not always have a space either side of the "x"
• might include a space between the number and "mm"
• metre will be written as "m" and other times it will be "mt" or "mtrs"

Any tips on how to achieve?

[frederic.vandenplas]

Hi @Anonymous

The inconsistency of data and programming is in the case of working with strings a big problem, i don't know the background for this, but when i receive inconsistent data, i would throw it back  (easier said then done, i know)

This should help you for the examples you provided, i hope someone else posts a magical solution for you, i could learn from this

 too 

Sub GetStrings()

Dim str1 As String
str1 = "Bar round 35.0mm x 3m mild steel"
'str1 = "Section box 30 x 30 x 3mm mild steel"
'str1 = "Bar flat 80 x 8mm x 6.1m mild steel"
'str1 = "Rod 5 mm x 3mt stainless steel grade 304"

Dim str() As String
str = Split(str1, " ")

If InStr(str1, "Bar round") <> 0 Then
MsgBox Replace(str(2), "mm", "")
ElseIf InStr(str1, "Section box") <> 0 Then
MsgBox str(2)
MsgBox str(4)
ElseIf InStr(str1, "Bar flat") <> 0 Then
MsgBox str(2)
MsgBox Replace(str(4), "mm", "")
ElseIf InStr(str1, "Rod") <> 0 Then
MsgBox str(1)
End If

End Sub

[MechMachineMan]

Sub GetStrings()

Dim str1 As String
str1 = "Bar round 35.0mm x 3m mild steel"
'str1 = "Section box 30 x 30 x 3mm mild steel"
'str1 = "Bar flat 80 x 8mm x 6.1m mild steel"
'str1 = "Rod 5 mm x 3mt stainless steel grade 304"

Dim str() As String
str = Split(str1.ToUpper, "X")

MsgBox(ExtractNumbers(str(0)) & vblf & ExtractNumbers(str(1)) & ExtractNumbers(str(2)))


End Sub

Function ExtractNumbers(oField1 As String) As String
'Extracts the FIRST set on continuous numbers from the field.
oField1 = TRIM(oField1)
For each c as Char in oField1
 If IsNumeric(c) = True Then
   OutString = OutString & c
 Else
   If OutString <> ""
     Exit For
   End if
 End if
Next
ExtractNumbers = OutString
ENd Function

[Anonymous]

@frederic.vandenplas thanks,

it's the same everywhere, CAD managers tidying up procurements mess 

I can work with your code, although I would prefer not to differentiate between the different types of section (as thats not always consistent either!!!)

[Anonymous]

Hi @MechMachineMan

I got these results with your code

• Bar round 35.0mm x 3m mild steel

Index was outside the bounds of the array.

• Section box 30 x 30 x 3mm mild steel

3030

• Bar flat 80 x 8mm x 6.1m mild steel

80

86

• Rod 5 mm x 3mt stainless steel grade 304

Index was outside the bounds of the array.

[Anonymous]

This is my attempt, which is pretty long and drawn out.

I'm getting the two numbers, but I just need a way to set the 2nd number to null if its not required

oMaterial1 = "R00001 - Bar round 35.0mm x 3m mild steel"

'oMaterial1 = "R00002 - Section box 30 x 30 x 3mm mild steel"

'oMaterial1 = "R00003 - Bar flat 80 x 8mm x 6.1m mild steel"

'oMaterial1 = "R00004 - Rod 5 mm x 3mt stainless steel grade 304"

Dim oMaterial2 As String = Right(oMaterial1, Len(oMaterial1)-9)

'MsgBox(oMaterial2)

Dim count As Integer = 0

Dim myChars() As Char = oMaterial2.ToCharArray()
For Each ch As Char In myChars
     If Char.IsLetter(ch) Then
         count = count + 1
       ' MessageBox.Show(ch)
     ElseIf Char.IsWhiteSpace(ch) Then
         count = count + 1
         'MessageBox.Show(ch)
     ElseIf Char.IsDigit(ch) Then
         'MessageBox.Show(ch)
         Exit For
    End If
Next

'MsgBox(count)

Dim oMaterial3 As String = Right(oMaterial2, Len(oMaterial2)-count)
'MsgBox(oMaterial3)

numCount1 = 0

Dim myNums() As Char = oMaterial3.ToCharArray()
For Each ch As Char In myNums
     If Char.IsLetter(ch) Then
        'MessageBox.Show(ch)
         Exit For
     ElseIf Char.IsWhiteSpace(ch) Then
         'MessageBox.Show(ch)
         Exit For
     ElseIf Char.IsDigit(ch) Then
         'MessageBox.Show(ch)
         numCount1 = numCount1 + 1
    ElseIf Char.IsPunctuation(ch) Then
         'MessageBox.Show(ch)
         numCount1 = numCount1 + 1
    End If
Next

Dim strNum1 As String = Left(oMaterial3,numCount1)
MsgBox(strNum1)

Dim oMaterial4 As String = Right(oMaterial3, Len(oMaterial3)-numCount1)
'MsgBox(oMaterial4)

numCount2 = 0

Dim myNums2() As Char = oMaterial4.ToCharArray()
For Each ch As Char In myNums2
     If Char.IsLetter(ch) Then
         numCount2 = numCount2 + 1
        'MessageBox.Show(ch)
     ElseIf Char.IsWhiteSpace(ch) Then
         numCount2 = numCount2 + 1
         'MessageBox.Show(ch)
     ElseIf Char.IsDigit(ch) Then
         'MessageBox.Show(ch)
        Exit For
    End If
Next

Dim oMaterial5 As String = Right(oMaterial4, Len(oMaterial4)-numCount2)
'MsgBox(oMaterial5)

numCount3 = 0

Dim myNums3() As Char = oMaterial5.ToCharArray()
For Each ch As Char In myNums3
     If Char.IsLetter(ch) Then
         Exit For
        'MessageBox.Show(ch)
     ElseIf Char.IsWhiteSpace(ch) Then
         Exit For
        'MessageBox.Show(ch)
     ElseIf Char.IsDigit(ch) Then
         'MessageBox.Show(ch)
         numCount3 = numCount3 + 1
    ElseIf Char.IsPunctuation(ch) Then
         'MessageBox.Show(ch)
         numCount3 = numCount3 + 1
    End If
Next

'Dim oVal As String = Right(oMaterial5, Len(oMaterial5)-numCount3)
'MsgBox(oVal)

'unit = Left(oVal,2)
'MsgBox(unit)
'If unit = "mm" Then

Dim strNum2 As String = Left(oMaterial5,numCount3)
MsgBox(strNum2)

'Else
'strNum2 = ""
'End If

[pball]

Here is my voodoo magic. It seems to work in the scenarios provided. It always provides the two numbers at the moment though.

Is there a rule for when only one number is needed? Is that input on your end or something that could be determined from the input string?

Sub numbers()
    oMaterial1 = "R00001 - Bar round 35.0mmx3m mild steel"
    'oMaterial1 = "R00002 - Section box 30 x 30 x 3mm mild steel"
    'oMaterial1 = "R00003 - Bar flat 80 x 8mm x 6.1m mild steel"
    'oMaterial1 = "R00004 - Rod 5 mm x 3mt stainless steel grade 304"

    Dim regex As Object
    Dim regexMatches As Object
    
    Set regex = CreateObject("vbscript.regexp")
    regex.IgnoreCase = True
    regex.Global = True

    'Voodoo Magic
    regex.Pattern = " ([\d\.]+).*?(| )x(| )([\d\.]+).*? "
    Set regexMatches = regex.Execute(oMaterial1)

    Debug.Print regexMatches.Item(0).submatches.Item(0) & " -- " & regexMatches.Item(0).submatches.Item(3)
End Sub

[perrysc · Accepted solution]

Hope this works for you

Sub Main()

    Dim oRawString As String = "Rod 5 mm x 3mt stainless steel grade 304" 'your string goes HERE
    Dim oMessage As String = "Raw String:" & vbLf & oRawString & vbLf & "Extracted Values:"
    Dim oValues As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
    Call _StringDefragifier(oRawString,oValues)
    For i As Integer = 1 To oValues.Count
        oMessage = oMessage & vbLf & oValues.Item(i)
    Next
    MsgBox(oMessage)

End Sub

Sub _StringDefragifier(oRawString As String,oCollection As ObjectCollection)
    
    Dim oWorkingString As String = _RemoveExtraneous(oRawString)
    Dim oFirstValue As String = _GetNumeric(oWorkingString)
    oWorkingString = Right(oWorkingString,Len(oWorkingString)-Len(oFirstValue))
    oCollection.Add(oFirstValue)
    oWorkingString = _RemoveExtraneous(oWorkingString)
    Dim oSecondValue As String = _GetNumeric(oWorkingString)
    oWorkingString = Right(oWorkingString,Len(oWorkingString)-Len(oSecondValue))
    Dim oCharsToNextValue As Integer = 0
    For i As Integer = 1 To Len(oWorkingString)
        If Not IsNumeric(Mid(oWorkingString,i,1)) Then
            oCharsToNextValue += 1
        Else
            Exit For
        End If
    Next
    If oCharsToNextValue < 9 Then 'Careful - assumes characters between dimensions no greater than 8
        oCollection.Add(oSecondValue)
    End If

End Sub

Function _RemoveExtraneous(oString As String) As String
    For j As Integer = 1 To Len(oString)
        If IsNumeric(Mid(oString,j,1)) Then
            _RemoveExtraneous = Right(oString,Len(oString)-(j-1))
            Exit For
        End If
    Next
End Function

Function _GetNumeric(oString As String) As String
    Dim oDummyValue As String = ""
    For j As Integer = 1 To Len(oString)
        If Not Asc(Mid(oString,j,1).ToUpper)>=Asc("A") AndAlso Not Asc(Mid(oString,j,1).ToUpper)>=Asc("Z") Then
            oDummyValue = oDummyValue & Mid(oString,j,1)
        Else
            _GetNumeric = oDummyValue
            Exit For
        End If
    Next
End Function

[Anonymous]

@pball

Looks interesting, I'll need to wait till tomorrow to try it out. 

I guess a rule could be when there are 3 numbers then the first 2 are returned and when there are 2 numbers then the 1st number is returned

[Anonymous]

@perrysc

Spot on!

+ it handles imperial UoM as well  which was my next worry

Thanks

[perrysc]

No problem, glad to help.