split string at every nth Word but ignoring counting those in parentheses

morad medo

New Member
Joined
Jun 7, 2019
Messages
4
I am using the following UDF to split a long string into rows of predefined number of words in based on input incell "D3".


Public Function SplitOnNth(ByVal inputStr$, ByVal StartPos&, ByVal NumWords&) As String



Dim arr() As String, i As Long, newArr() As String

arr = Split(inputStr)

ReDim newArr(NumWords - 1)



'Arrays are zero-based, but your string isn't. Subtract 1

For i = StartPos - 1 To StartPos + NumWords - 2

If i > UBound(arr) Then Exit For 'Exit if you loop past the last word in string



'ANYTHING IN PARENTHESES SHOULD BE SKIPPED IN WORDS COUNT BUT INCLUDED IN THE WORDS SPLIT



newArr(i - StartPos + 1) = arr(i)

Next



SplitOnNth = Join(newArr, " ")



End Function



For my cells setup please see attached image:
37CAe.jpg



Depending on the value in cell "D3" (in this case 4) the string is split perfectly into rows but because the string has some numbers in parentheses (which could be anywhere in the string) these should be skipped and not be counted in the splitting of the string. These numbers in parentheses, however, should be part of the final result in their exact position as depicted by the image attached. the drawing on the image attached shows the expected result 4 words in each row plus whatever number in the parentheses.



Your help is much appreciated and thanks in advance.
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
There are a couple of things that aren't clear:
- how do you want multi-word parenthesis handled. e.g. "one two (alpha beta) three four"
- handeling of improper parenthesisation e.g. "one two (alpha (beta) three four"
- how do you want the result returned, as an array of results or individually.

The UDF NWords will return either a single result if the optional Index argument is specified or a row-wise array if it is omitted.
Code:
Function NWords(rawString As String, Optional wordsPerResult As Long = 2, Optional Index As Long = -1)
    Dim rawWords As Variant
    Dim inPointer As Long, outPointer As Long
    Dim foundWords As String, Size As Long
    Dim newResult() As String
    Dim Results() As String, resultCount As Long
    
    rawWords = Split(rawString, " ")
    Size = UBound(rawWords)
    If Size < 0 Then NWords = vbNullString: Exit Function
    
    ReDim Results(1 To Size + 1)
    inPointer = 0
    
    Do
        foundWords = wordsPerResult
        ReDim newResult(0 To Size)
        outPointer = 0
        Do
            newResult(outPointer) = rawWords(inPointer)
            If Not (rawWords(inPointer) Like "(*)") Then
                foundWords = foundWords - 1
            End If
            inPointer = inPointer + 1
            outPointer = outPointer + 1
            
        Loop Until (Size < inPointer) Or (foundWords <= 0)
        
        resultCount = resultCount + 1
        Results(resultCount) = Trim(Join(newResult, " "))
    Loop Until (Size < inPointer)
    
    If Index < 1 Then
        If TypeName(Application.Caller) = "Range" Then
            resultCount = Application.Caller.Cells.Count
        End If
        ReDim Preserve Results(1 To resultCount)
        NWords = Results
    Else
        If Index <= resultCount Then
            NWords = Results(Index)
        Else
            NWords = vbNullString
        End If
    End If
End Function

In your example, you would put =NWords($B$3, $D$3, 1) in G4, =NWords($B$3, $D$3, 2) in G5, etc.
or
Put =NWords($B$3, $D$3, ROW(A1)) in G4 and drag down
or
select G4:G10 and enter the array function =TRANSPOSE(NWords($B$3, $D$3))
 
Upvote 0
I know you asked for a UDF, but do you really need that? Would a macro that you run when the text in B3 is changed be acceptable?
 
Upvote 0
I don't mind a macro. This is a learning process that I really enjoy.
Okay, here is a macro that should work (all it needs is the text in cell B3 and the number of words in cell D3)...
Code:
[table="width: 500"]
[tr]
	[td]Sub NWords()
  Dim R As Long, NumWords As Long, S As String, Text As String, Words As Variant
  Text = [SUBSTITUTE(TRIM(B3)," (",CHAR(1)&"(")] & Space([D3])
  If Left(Text, 1) = "(" Then Text = Replace(Text, ") ", ")" & Chr(1), , 1)
  Words = Split(Text)
  Columns("F").ClearContents
  On Error GoTo NoMoreWords
  For R = 0 To UBound(Words) Step [D3]
    [F4].Offset(R / [D3]) = Replace(Join(Application.Transpose(Application.Index(Words, Evaluate("ROW(" & R + 1 & ":" & R + [D3] & ")")))), Chr(1), " ")
  Next
NoMoreWords:
End Sub[/td]
[/tr]
[/table]
 
Upvote 0
Okay, here is a macro that should work (all it needs is the text in cell B3 and the number of words in cell D3)...
Code:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub NWords()
  Dim R As Long, NumWords As Long, S As String, Text As String, Words As Variant
  Text = [SUBSTITUTE(TRIM(B3)," (",CHAR(1)&"(")] & Space([D3])
  If Left(Text, 1) = "(" Then Text = Replace(Text, ") ", ")" & Chr(1), , 1)
  Words = Split(Text)
  Columns("F").ClearContents
  On Error GoTo NoMoreWords
  For R = 0 To UBound(Words) Step [D3]
    [F4].Offset(R / [D3]) = Replace(Join(Application.Transpose(Application.Index(Words, Evaluate("ROW(" & R + 1 & ":" & R + [D3] & ")")))), Chr(1), " ")
  Next
NoMoreWords:
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

WOW :) :) :)
very concise and elegant ! ! !
Thank you so much.



Code:
[TABLE="class: cms_table, width: 500"]
<tbody>[TR]
[TD]Sub NWords() Dim R As Long, NumWords As Long, S As String, Text As String, Words As Variant Text = [SUBSTITUTE(TRIM(B3)," (",CHAR(1)&"(")] & Space([D3]) If Left(Text, 1) = "(" Then Text = Replace(Text, ") ", ")" & Chr(1), , 1) Words = Split(Text) Columns("F").ClearContents On Error GoTo NoMoreWords For R = 0 To UBound(Words) Step [D3] [F4].Offset(R / [D3]) = Replace(Join(Application.Transpose(Application.Index(Words, Evaluate("ROW(" & R + 1 & ":" & R + [D3] & ")")))), Chr(1), " ") Next NoMoreWords: End Sub

[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,192
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top