Split words into 1d array

[YasserKhalil]

Hello everyone

I have a string of seven words and I have a 1d array (5 elements). How to split the string so as to put each word in an element of the array .. so the first word goes to the first element .. and so on. The fourth word goes to the fourth element. The rest of the words (the fifth - the sixth - the seventh) go to the last and fifth element of the array. Of course, the string may vary in the number of words.
In another case, if the string consists of only three words, then the first word to the first element, the second word to the second element but the last word should go to the last (fifth) element of the array.

I am trying the following, but the last element has incorrect result. It should have `of seven words`

Code: Select all

Sub Test_SplitWords_UDF()
    Dim v
    v = SplitWords("This Is A String Of Seven Words")
End Sub

Function SplitWords(ByVal sInputString As String)
    Dim Words() As String, SplitWord() As String, sTemp As String, i As Long
    Words = Split(sInputString, " ")
    If UBound(Words) <= 4 Then
        ReDim SplitWord(0 To 4)
        For i = 0 To UBound(Words) - 1
            SplitWord(i) = Words(i)
        Next i
        SplitWord(UBound(SplitWord)) = Words(UBound(Words))
    Else
        ReDim SplitWord(0 To 4)
        For i = 0 To 3
            SplitWord(i) = Words(i)
        Next i
        If UBound(Words) > 3 Then
        For i = 4 To UBound(Words)
            sTemp = sTemp & IIf(sTemp = Empty, Empty, " ") & Words(i)
        Next i
        SplitWord(4) = sTemp
        End If
        'SplitWord(4) = Join(Split(Join(Words, " "), " ", 4), " ")
    End If
    SplitWords = SplitWord
End Function

I could solve it using loops

Code: Select all

        For i = 4 To UBound(Words)
            SplitWord(4) = SplitWord(4) & IIf(SplitWord(4) = Empty, Empty, " ") & Words(i)
        Next i

But I am curious if I can use Join and Split functions in one line instead.

[SpeakEasy]

Since you are already using a method that loops through the words, I think I'd probably not bother with split, and go with something like

Code: Select all

Function SplitWords(ByVal sInputString As String)
    Dim SplitWord() As String
    Dim i As Long
    Dim start As Long
    Dim last As Long
    
    start = 1
    ReDim SplitWord(4) As String
    Do
        last = InStr(start, sInputString, " ")
        If last > 0 Then
            SplitWord(i) = Mid$(sInputString, start, last - start)
            start = last + 1
            i = i + 1
        End If
    Loop Until i = 4 Or last <= 0
    SplitWord(i) = Right(sInputString, Len(sInputString) - start + 1)
    ReDim Preserve SplitWord(i) As String
    SplitWords = SplitWord
End Function

But if you do want to continue using Split, something like this should work

Code: Select all

Function SplitWords3(ByVal sInputString As String)
    Dim SplitWord() As String
    Dim i As Long

    SplitWord = Split(sInputString, " ")
    
    For i = 5 To UBound(SplitWord)
        SplitWord(4) = SplitWord(4) & " " & SplitWord(i)
    Next
    
    If UBound(SplitWord) > 3 Then ReDim Preserve SplitWord(4) As String
    
    SplitWords3 = SplitWord
End Function

[DocAElstein]

Don't forget that you can use the third argument of Split

Code: Select all

Option Explicit
Sub SplitUseThirdArgument()
Dim Vee() As String
 Let Vee() = Split("This Is A String Of Seven Words", " ", 5, vbBinaryCompare)
End Sub

May not do all you want, but worth bearing in mind.

[SpeakEasy]

Yeah, that'd work!

[DocAElstein]

not for everything - for less than 5 words, have to fiddle the string a bit before, to get the last word in the last element as he wants.

[SpeakEasy]

>last word in the last element

Good point. I actually missed that requirement. So both my solutions need a minor tweak! But I'm off to the pub now, so it'll have to wait.

[DocAElstein]

I'm off to jog along my train track in the Bavarian Hills, - ..Beer? - maybe that or something similar later after...

[SpeakEasy]

I lied. Managed to squeeze in this minor modification of SplitWords3

Code: Select all

Function SplitWords3(ByVal sInputString As String)
    Dim SplitWord() As String
    Dim reposition
    'Dim i As Long

    SplitWord = Split(sInputString, " ", 5) ' improvement suggested by DocAElstein
    
    'OR my original, which achieves the same thing
'    SplitWord = Split(sInputString, " ")
'    For i = 5 To UBound(SplitWord)
'        SplitWord(4) = SplitWord(4) & " " & SplitWord(i)
'    Next
    
    reposition = UBound(SplitWord)
    ReDim Preserve SplitWord(4) As String
    If reposition > -1 And reposition < 4 Then
        SplitWord(4) = SplitWord(reposition)
        SplitWord(reposition) = ""
    End If

    SplitWords3 = SplitWord
End Function

So, NOW I can go to the pub ...

[DocAElstein]

Aren’t all the Pubs on strike like everyone else in Britain????

_.__________________

A few variations that do something similar.
I have not considered the case of a single word, (and if you had more than a single space between words you could use Application.Trim at the start to sort that out)

Code: Select all

Sub GiveMe5() ' https://eileenslounge.com/viewtopic.php?p=304283#p304283
Dim InplutSting As String: Let InplutSting = "This Is A String Of Seven Words"
Let InplutSting = "This Is It"
'Let InplutSting = "This Is"
Let InplutSting = "This Is It Then"
Dim Spcis As Long: Let Spcis = Len(InplutSting) - Len(Replace(InplutSting, " ", "", 1, -1, vbBinaryCompare))
    If Spcis < 4 Then
    Dim LstSpc As Long: Let LstSpc = InStrRev(InplutSting, " ", -1, vbBinaryCompare)
     Mid(InplutSting, LstSpc, 1) = "#"
     Let InplutSting = Replace(InplutSting, "#", Space(5 - Spcis), 1, -1, vbBinaryCompare)
    Else
    
    End If
Dim Vee() As String
 Let Vee() = Split(InplutSting, " ", 5, vbBinaryCompare)
End Sub
Sub GiveMeFive()
Dim InplutSting As String: Let InplutSting = "This Is A String Of Seven Words"
'Let InplutSting = "This Is It"
Let InplutSting = "This Is"
Let InplutSting = "This Is It Then"
Dim Spcis As Long: Let Spcis = Len(InplutSting) - Len(Replace(InplutSting, " ", ""))
    If Spcis < 4 Then
    'Dim LstSpc As Long: Let LstSpc = InStrRev(InplutSting, " ", -1, vbBinaryCompare)
     Mid(InplutSting, InStrRev(InplutSting, " "), 1) = "#"
     Let InplutSting = Replace(InplutSting, "#", Space(5 - Spcis), 1, -1, vbBinaryCompare)
    Else
    
    End If
Dim Vee() As String
 Let Vee() = Split(InplutSting, " ", 5, vbBinaryCompare)
End Sub
Sub GiveMeFiver()
Dim InplutSting As String: Let InplutSting = "This Is A String Of Seven Words"
Let InplutSting = "This Is It"
'Let InplutSting = "This Is"
Let InplutSting = "lis Is It Len"
Dim Spcis As Long: Let Spcis = Len(InplutSting) - Len(Replace(InplutSting, " ", ""))
    If Spcis < 4 Then
     Dim LstSpc As Long: Let LstSpc = InStrRev(InplutSting, " ", -1, vbBinaryCompare)
     Let InplutSting = Left(InplutSting, LstSpc) & Replace(InplutSting, " ", Space(4 - Spcis), LstSpc, 1, vbBinaryCompare)
    Else
    
    End If
Dim Vee() As String
 Let Vee() = Split(InplutSting, " ", 5, vbBinaryCompare)
End Sub
Sub GiveMeAFiver()
Dim InplutSting As String: Let InplutSting = "This Is A String Of Seven Words"
Let InplutSting = "This Is It"
'Let InplutSting = "This Is"
Let InplutSting = "Lis Is It Lenny"
Dim Spcis As Long: Let Spcis = Len(InplutSting) - Len(Replace(InplutSting, " ", ""))
    If Spcis < 4 Then
     Let InplutSting = Left(InplutSting, InStrRev(InplutSting, " ")) & Replace(InplutSting, " ", Space(4 - Spcis), InStrRev(InplutSting, " "))
    Else
    
    End If
Dim Vee() As String
 Let Vee() = Split(InplutSting, " ", 5, vbBinaryCompare)
End Sub

Sub GivUsAFiver()
Dim InplutSting As String: Let InplutSting = "This Is A String Of Seven Words"
Let InplutSting = "This Is It"
'Let InplutSting = "This Is"
Let InplutSting = "Lis Is It Lenny"
Dim Spcis As Long: Let Spcis = Len(InplutSting) - Len(Replace(InplutSting, " ", ""))
    If Spcis < 4 Then Let InplutSting = Left(InplutSting, InStrRev(InplutSting, " ")) & Replace(InplutSting, " ", Space(4 - Spcis), InStrRev(InplutSting, " "))
Dim Vee() As String
 Let Vee() = Split(InplutSting, " ", 5)
End Sub

[YasserKhalil]

Thank you everyone for sharing these great ideas.