Custom Function to Delimit Cell by ";" Need more delimiters

[jonesalexr]

Hello,

I was able to find the below code for a custom function to read a cell and pull back the delimited value to a cell.

Function ExtractElement(str, n, sepChar)
'   Returns the nth element from a string,
'   using a specified separator character
    Dim x As Variant
    x = Split(str, sepChar)
    If n > 0 And n - 1 <= UBound(x) Then
       ExtractElement = x(n - 1)
    Else
        ExtractElement = ""
    End If
End Function

I am using the below formula to split the data of B2 into B3,B4,B5 etc
Cell B3=TRIM(ExtractElement($B$2, 1, ";"))
Cell B4=TRIM(ExtractElement($B$2, 2, ";"))

Right now it only works if i use ";" as my delimiter. I would like to use anything but a number or letter as a delimiter. This could include spaces and symbols. The field that is delimited is filled out by various people and will typically use a "," or ";", but i need to include all delimiters.

 

[jonesalexr]

Does anyone know how to edit this function to add multiple symbols as a delimiter?

 

[Peter_SSs]

Is this what you mean?

Function ExtrElement(str As String, n As Long) As String
  Static RX As Object
  
  Dim s As String
  Dim ary As Variant
  
  Const mYDelimiters As String = "., ;:'\|/!" '<- Add/remove delimiters here
    
  If RX Is Nothing Then
      Set RX = CreateObject("VBScript.RegExp")
      RX.Global = True
      RX.Pattern = "[" & mYDelimiters & "]"
  End If
  ary = Split(RX.Replace(str, "|"), "|")
  If n > 0 And n - 1 <= UBound(ary) Then
    ExtrElement = ary(n - 1)
  End If
End Function

Formula in B5 is copied across and down.

Excel Workbook
	A	B	C	D	E	F
5	abc,def,ghi	abc	def	ghi
6	abc.def:hui	abc	def	hui
7	b/d/r	b	d	r
8
9	rty.d/345|asd	rty	d	345	asd
10	vba	vba
Sheet2

 

[Peter_SSs]

I would like to use anything but a number or letter as a delimiter.

In that case, rather than make a list of delimiters to use as in my previous code, you could try this variation.

Function ExtrElement(str As String, n As Long) As String
  Static RX As Object
  
  Dim ary As Variant
    
  If RX Is Nothing Then
      Set RX = CreateObject("VBScript.RegExp")
      RX.Global = True
      RX.Pattern = "[^a-zA-Z0-9]"
  End If
  ary = Split(RX.Replace(str, "|"), "|")
  If n > 0 And n - 1 <= UBound(ary) Then
    ExtrElement = ary(n - 1)
  End If
End Function

Also note that the "Dim s as String" that I had in my last code should have been removed.

 

[jonesalexr]

I used the last code you posted and it worked like a charm! Thank you! I just had to change the Absolute and Rows. Is there a way to treat consecutive delimiters (of different types) as one. The problem is that if they do semi "; " to separate the data, it places a space between my rows

 

[Rick Rothstein]

I used the last code you posted and it worked like a charm! Thank you! I just had to change the Absolute and Rows. Is there a way to treat consecutive delimiters (of different types) as one. The problem is that if they do semi "; " to separate the data, it places a space between my rows

The only possible problems with doing that is you lose your count position if there is one or more leading delimiters and valid consecutive delimiters (for example, one,,three) become meaningless. Here is a function that that does not call out to a RegExp engine the way Peter's does (the function uses native VBA functions and statements) which does what Peter's function does plus I added an optional third argument to allow you to specify whether the function should treat consecutive delimiters as one or not... I have defaulted that optional argument to True meaning if you omit the third argument (or specify True for it), consecutive non-letter, non-number characters will be treated as single delimiters whereas if you specify False for that third argument, all non-letter, non-number characters will be treated as independent delimiters. Also note that I called my function GetElement to differentiate it from Peter's.

Function GetElement(ByVal S As String, N As Long, Optional NoConsecutives As Boolean = True) As String
  Dim X As Long
  For X = 1 To Len(S)
    If Mid(S, X, 1) Like "[!0-9A-Za-z]" Then Mid(S, X) = " "
  Next
  If NoConsecutives Then S = Application.Trim(S)
  If N > 0 Then GetElement = Split(S & String(N, " "))(N - 1)
End Function

 

[Rick Rothstein]

Function GetElement(ByVal S As String, N As Long, Optional NoConsecutives As Boolean = True) As String
  Dim X As Long
  For X = 1 To Len(S)
    If Mid(S, X, 1) Like "[!0-9A-Za-z]" Then Mid(S, X) = " "
  Next
  If NoConsecutives Then S = Application.Trim(S)
  If N > 0 Then GetElement = Split(S & String(N, " "))(N - 1)
End Function

Just to follow up on the above code (which I posted in Message #6), here are some examples to clarify the use of that third, optional argument (note, ignore all quote marks as they are there solely to delineate the text in the cells, they will not be part of the cell's value)...

A1: "One,,Two,Three"


B1:  =GetElement(A1,2)        ==>   "Two" 


B1:  =GetElement(A1,2,TRUE)   ==>   "Two"


B1:  =GetElement(A1,2,FALSE)  ==>   ""

 

[jonesalexr]

Just to follow up on the above code (which I posted in Message #6), here are some examples to clarify the use of that third, optional argument (note, ignore all quote marks as they are there solely to delineate the text in the cells, they will not be part of the cell's value)...

A1: "One,,Two,Three"


B1:  =GetElement(A1,2)        ==>   "Two" 


B1:  =GetElement(A1,2,TRUE)   ==>   "Two"


B1:  =GetElement(A1,2,FALSE)  ==>   ""

You are awesome! Thats great. I really dont care if it skips a blank delimited column, I just want to make sure I don't have to double the length of my lookup table to account for spaced cells between the data. Have a great weekend!

 

[Peter_SSs]

Is there a way to treat consecutive delimiters (of different types) as one.

For my function, just adding a "+" sign as shown will treat consecutive delimiters, whether they are the same or different, as one.

RX.Pattern = "[^a-zA-Z0-9]+"