Extract a section of a text string to anew column - Excel 2003

[TC]

Hi Gurus

I would really appreciate if I could have a VBA script/ Macro that
will do the following:-

Extract eg 32MPA , 20MPA , 40MPA fro a text string as per below
sample.

POST TENS 32MPA 20MM 22@3 90 AIR TESTED
GREEN 60 20MPA 20MM
CONCRETE_POLISHED___32MPA_10MM_SHRINKAGE LTD
CONCRETE_DURAMIX___40MPA_20MM_MACFOLSPEC

Thanking you in anticipation.

Cheers
Tony

 

[Ron Rosenfeld]

Hi Gurus

I would really appreciate if I could have a VBA script/ Macro that
will do the following:-

Extract eg 32MPA , 20MPA , 40MPA fro a text string as per below
sample.

POST TENS 32MPA 20MM 22@3 90 AIR TESTED
GREEN 60 20MPA 20MM
CONCRETE_POLISHED___32MPA_10MM_SHRINKAGE LTD
CONCRETE_DURAMIX___40MPA_20MM_MACFOLSPEC

Thanking you in anticipation.

Cheers
Tony

Here's a routine using Regular Expressions:

======================
Option Explicit
Function ExtrString(Str As String, sPattern As String) As String
Dim re As Object, mc As Object
Set re = CreateObject("vbscript.regexp")
re.IgnoreCase = True
re.Pattern = sPattern
If re.test(Str) = True Then
Set mc = re.Execute(Str)
ExtrString = mc(0).Value
End If
End Function
===============================

The pattern to extract several digits, followed by MPA is:

"\d+MPA"

So the function would be:

=ExtrString(A1,"\d+MPA")

Note that the UDF as written is case insensitive. To make the routine case
sensitive, merely delete or comment out the re.ignorecase=True line.
--ron

 

[Mark Ivey]

Here is a snippet you can start with...


Mark Ivey




' Assuming your string values are starting in "A1" and
' progress down the page, this snippet will look through
' cells A1 to A10... extract the MPA values and put a copy
' of them in the column E of the same row.
For i = 1 To 10
If Cells(i, 1).Value <> "" Then
myMPA = Mid(Cells(i, 1), (InStr(1, Cells(i, 1), "MPA")) - 2, 5)
Cells(i, 5).Value = myMPA
End If
Next