Copy String up to the 3rd Space

[Factor3]

Hey All,

I'm trying to take a string and only copy the first 3 words of it (separated by spaces). I'm 99% of the way there, I just can't figure out where to next the rest of my Do While .... Loops.



Private Sub TrimName(text As String)

Dim i As Integer
Dim newText As String
i = 1

Do While Mid(text, i, 1) <> " "
newText = Left(text, i)
i = i + 1
Loop

'this copies the FIRST WORD of my String, I just need the next two:banghead:

End Sub


Thanks all!

BMG

[Cosmo]

A quick throw together, there's probably a better way to do it
Dim x As String
Dim y
x = "THis is a test asdrkj"
y = Split(x)
Debug.Print y(0) & " " & y(1) & " " & y(2)

[mdmackillop]

Sub FirstThreeWords()
Dim test
test = Split(Range("A1"))
ReDim Preserve test(2)
MsgBox Join(test, " ")
End Sub

[Factor3]

Wow,

Thank you so much (both of you). Although after seeing your solution I certainly feel like I was using a hammer to screw in a lightbulb:wot

Interesting methods that I've never seen before!

Thank you again,

BMG

[mdmackillop]

Happy to help. Just for information, you could solve this with a loop and the InStr function. Find the first space, then search after that for the next and so on. Split is much neater though.

[Cosmo]

Excellent. I knew that Join would be the way to go, but I apparently wasn't using the Redim properly when I initially tried it (and since split will fill the rest of the original string into the last space of the array, without it you'd end up with the original string again)

I may have uses for this myself at some time, so I decided to expand your solution into a function which will allow for selecting the number of words:
Private Function firstWords(ByVal theString As String, Optional ByVal wordCount As Integer = 1) As String
Dim test
Dim totalWordCount As Integer

test = Split(theString)
totalWordCount = UBound(test) - LBound(test) + 1
If wordCount > totalWordCount Then
wordCount = totalWordCount
ElseIf wordCount < 1 Then
firstWords = ""
Exit Function
End If
wordCount = wordCount - 1
ReDim Preserve test(wordCount)
firstWords = Join(test, " ")
End Function

[mdmackillop]

You can do it quite simply with a loop. Double spaces would need to be sorted (as they would with the previous solution, now I think about it)


Option Explicit
Sub test()
Dim txt As String
txt = "A quick throw together, there's probably a better way to do it"
MsgBox FirstWords(txt, 3)
End Sub

Function FirstWords(Data As String, Words As Long)
Dim x As Long, i As Long
'Fix large spaces
Do
Data = Replace(Data, " ", " ")
Loop Until InStr(1, Data, " ") = 0
'Count spaces
x = 0
Do
x = InStr(x + 1, Range("A1"), " ")
i = i + 1
Loop Until i = Words
'Result
FirstWords = Left(Data, x)
End Function

[Cosmo]

Good catch. I hadn't thought of multiple consecutive spaces.

btw, I think you meant x = InStr(x + 1, Range("A1"), " ") to be x = InStr(x + 1, data, " ")


Also, I tried FirstWords = Left(Data, x - 1) to get rid of the final space, but it doesn't work if the word count is less than the supplied number. Is there an easy way to remove the last space?

[BrianMH]

Just use Trim on the string to get rid of any spaces on the beginning and end.