Parse cell contents to new columns
On Sun, 8 Mar 2009 06:08:01 -0700, Frank Pytel
wrote:
All values will be separated by spaces which is nice. I have gotten as far
as the first space but can't seem to tell it to find the second, third etc.
spaces.
Although you can certainly do this with formulas, why not use the
Data/Text-to-Columns wizard with <space as the delimiter?
(Select Data from the main menu or ribbon; then select text-to-columns and go
through the wizard steps).
If you really need to do it with a formula, you could use this UDF (user
defined function).
To enter this User Defined Function (UDF), <alt-F11 opens the Visual Basic
Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.
To use this User Defined Function (UDF), with your string in A1, enter a
formula like
B1: =REMid($A$1,"\S+",COLUMNS($A:A))
and fill right as far as required.
The "\S+" pattern argument means match patterns that consist of non-spaces
(hence it will break on spaces),
and the COLUMNS($A:A) for the Index argument will increment by one each time
you fill right.
Note the comment in the code about setting a reference.
====================================
Option Explicit
Function REMid(Str As String, Pattern As String, _
Optional Index As Variant = 1, _
Optional CaseSensitive As Boolean = True, _
Optional MultiLin As Boolean = False) _
As Variant 'Variant as value may be string or array
'Requires setting reference (see Tools/References at top menu
'to Microsoft VBScript Regular Expressions 5.5
'Index -- negative values return groups counting from end of string
Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection
Dim i As Long 'counter
Dim T() As String 'container for array results
' Create a regular expression object.
Set objRegExp = New RegExp
'Set the pattern by using the Pattern property.
objRegExp.Pattern = Pattern
' Set Case Insensitivity.
objRegExp.IgnoreCase = Not CaseSensitive
'Set global applicability.
objRegExp.Global = True
'Set multiline
objRegExp.MultiLine = MultiLin
'Test whether the String can be compared.
If (objRegExp.Test(Str) = True) Then
'Get the matches.
Set colMatches = objRegExp.Execute(Str) ' Execute search.
On Error Resume Next 'return null string if a colmatch index is non-existent
If IsArray(Index) Then
ReDim T(1 To UBound(Index))
For i = 1 To UBound(Index)
T(i) = colMatches(IIf(Index(i) 0, Index(i) - 1, Index(i) _
+ colMatches.Count))
Next i
REMid = T()
Else
REMid = CStr(colMatches(IIf(Index 0, Index - 1, Index + _
colMatches.Count)))
If IsEmpty(REMid) Then REMid = ""
End If
On Error GoTo 0 'reset error handler
Else
REMid = ""
End If
End Function
==================================
--ron
|