Link to home
Create AccountLog in
Avatar of Keith Conaway
Keith ConawayFlag for United States of America

asked on

Excel vba - need to strip off 7 words from the right in a cell.

Trying to automate spreadsheet with vba-

 Normal cell: 005 Mech Room 1 5.0 Jul 1900 242 4.9 1067.0 0.23
Desired cell: 005 Mech Room 1

I need a routine to more or less count spaces or words from the right and then trim off?
The data is consistent. 7 words or spaces from the right in each cell. The character count can vary so I can't just trim. But the word count is consistent (from right only).
Avatar of Jeff Darling
Jeff Darling
Flag of United States of America image

Here is a function that produces the output using split.

Public Function parsetest(strInput As String, iWords As Integer) As String

Dim strInputs() As String
Dim strOutput As String

strInputs = Split(strInput, " ")

For i = 0 To iWords - 1

strOutput = strOutput & strInputs(i) & " "

Next i

parsetest = Trim(strOutput)

End Function

Open in new window

Avatar of Jeff Darling
Jeff Darling
Flag of United States of America image

Link to home
Create a free account to see this answer
Signing up is free and takes 30 seconds. No credit card required.
See answer
This should work
Sub test()
   Dim arr() As String, i As Integer
   arr = split(Range("A7").Value, " ")
   For i = 0 To UBound(arr) - 7
      Range("B8").Value = Range("B8").Value & arr(i) & " "
End Sub

Open in new window

Here is a macro that will work on a selected range of cells, with any number of rows and/or columns. If the cell contains more than 7 spaces, it will be truncated to delete the last 7 spaces plus all text to the right of them. The macro uses array transfer for speed. Results will be placed in the original cells.

As written, the macro ignores cells that are blank, contain less than 7 spaces, contain error values or are numbers. If the user inadvertently selects an entire column, the macro only processes those cells that are within the used range.
Sub DeleteLast7Words()
Dim rg As Range
Dim v As Variant
Dim i As Long, j As Long, k As Long
Set rg = Intersect(ActiveSheet.UsedRange, Selection.Cells)
If Not rg Is Nothing Then
    On Error Resume Next
    v = rg.Value
    For i = rg.Rows.Count To 1 Step -1
        For j = rg.Columns.Count To 1 Step -1
            k = 0
            k = Len(v(i, j)) - Len(Replace(v(i, j), " ", ""))
            If k > 7 Then v(i, j) = Left(v(i, j), InStr(1, Application.Substitute(v(i, j), " ", "|", k - 7), "|") - 1)
    rg.Value = v
    On Error GoTo 0
End If
End Sub

Open in new window