VBA to remove everything after 5 spaces-CodePudding

Have this VBA code which removes eveything after first space

Trying to modify it so it removes eveything after 5 spaces instead in the whole of sheet1 cells or post results into sheet 2 either way is ok

for example

from

It was a good day today but a little cold

It was a good day today

Sub Test()
 Dim X As Long, Uniques() As String, Obj As Object
 Dim Data As Variant, Results As Variant, ObjKeys() As String
 Application.ScreenUpdating = False
 Data = Range("H2", Cells(Rows.Count, "H").End(xlUp)).Value
 For X = 1 To UBound(Data)
   Data(X, 1) = Left(Data(X, 1), InStr(Data(X, 1) & " ", " ") - 1)
 Next
 Set Obj = CreateObject("Scripting.Dictionary")
 With CreateObject("Scripting.Dictionary")
   For X = 1 To UBound(Data)
     Obj.Item(CStr(Data(X, 1))) = 1 ' CStr(Data(X, 1))
   Next
   ObjKeys = Split(Join(Obj.keys))
   ReDim Results(1 To UBound(ObjKeys)   1, 1 To 1)
   For X = 0 To UBound(ObjKeys)
     Results(X   1, 1) = ObjKeys(X)
   Next
   Range("H2").Resize(UBound(Data)) = Data
   Sheets("Sheet2").Range("J1").Value = Range("H1").Value
   Sheets("Sheet2").Range("J2").Resize(UBound(Results)) = Results
 End With
 Application.ScreenUpdating = True
End Sub

CodePudding user response：

You could do it like this:

Const NUM_SPACES As Long = 5
Dim s As String, arr

s = "It was a good day today but a little cold"

arr = Split(s, " ", NUM_SPACES   2)   'split to max 7 elements

'remove anything in the last position (arr starts at zero)
If UBound(arr) = NUM_SPACES   1 Then arr(NUM_SPACES   1) = ""  

Debug.Print Join(arr, " ") '> It was a good day today

CodePudding user response：

An alternative solution which does not require VBA:

=TRIM(LEFT(SUBSTITUTE(A1," ",REPT(" ",100)),500))

This replaces each space with 100 spaces. Takes the first 500 (5*100 spaces) characters. Then removes all the additional spaces.

CodePudding user response：

If you have Office 365 with the latest functions, simply:

=TEXTBEFORE(A1," ",6)

Will return an error if there are not enough delimiters. You may want to specify what to happen if that is a possibility.

This can also be accomplished using Power Query, available in Windows Excel 2010 and Excel 365 (Windows or Mac)

To use Power Query

Select some cell in your Data Table
Data => Get&Transform => from Table/Range or from within sheet
When the PQ Editor opens: Home => Advanced Editor
Make note of the Table Name in Line 2
Paste the M Code below in place of what you see
Change the Table name in line 2 back to what was generated originally.
Read the comments and explore the Applied Steps to understand the algorithm

Again, since you did not specify what you want if there are not five spaces, this routine returns the entire string if there are fewer than five spaces

let
    Source = Excel.CurrentWorkbook(){[Name="Table7"]}[Content],

//create list of column headers
    colNames = Table.ColumnNames(Source),

//set all data types to text
    #"Changed Type" = Table.TransformColumnTypes(Source,
        List.Transform(colNames, each {_, type text})),

//Remove all after the fifth space (including that space)
    #"Trim Strings" = Table.TransformColumns(#"Changed Type", 
        List.Transform(colNames, (cn)=> {cn, each try Text.Combine(List.FirstN(Text.Split(_," "),5)," ") otherwise null}))

in
    #"Trim Strings"