View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
Ron Rosenfeld Ron Rosenfeld is offline
external usenet poster
 
Posts: 5,651
Default Extracting from string

On Tue, 18 Mar 2008 09:57:05 -0700, Phil Trumpy
wrote:

I'm using Excel 2007 - Data is in column A

I have a data set that I am trying to import. The first column really
should be 5 separate columns, but has been created as one string. I need to
separate into 5 columns. the data looks like this:

LastName, FirstName MI. Position Team

LastName and FirstName can be ulimited characters
MI can be 1 or 2 characters followed by a period
Position is 1 or 2 characters
Team is 3 characters

I attempted to use Text to Columns, but the problem is that the middile
initial does not always exist. If I can get the middle initial to a separate
column, I can use text to columns for the rest. I would prefer to just run
one macro to take care of the whole thing since I will have a different file
each year that has the same data structure. Sorry if I didn't provide enough
info. Thanks in advance.


This routine seems to meet your specifications.

It WILL return a last name containing <spaces as it uses the <comma for the
delimiter.

The MI is optional, but it does require that the MI follow FirstName and be one
or two letters followed by a <dot.

===================================
Option Explicit
Sub ParseString()
Dim c As Range, rg As Range
Dim Str As String
Dim re As Object, mc As Object, m As Object
Dim i As Long
Set re = CreateObject("vbscript.regexp")
re.ignorecase = True
re.Pattern = "(^\s*[^,]+),\s+(\S+)\s*([A-Z]{1,2}\.)?\s+(\S+)\s+(\S+)"

'set up range to parse
Set rg = Selection
'check that it is only a single column
If rg.Columns.Count < 1 Then
MsgBox ("Can only select a single column")
Exit Sub
End If
'one could expand selection to current column

For Each c In rg
Str = c.Value
Range(c(1, 2), c(1, 6)).ClearContents
If re.test(Str) Then
Set mc = re.Execute(Str)
For Each m In mc
If m.SubMatches.Count 0 Then
For i = 1 To m.SubMatches.Count
c.Offset(0, i).Value = m.SubMatches(i - 1)
Next i
End If
Next m
End If
Next c

End Sub
==================================
--ron