Hi Terry (and fellow Sydneyite),
Try these macros:
Option Explicit
Sub KeepFirstSeven()
Dim sn, tempArr, tempArr2
Dim i As Long, j As Long
Application.ScreenUpdating = False
sn = ActiveSheet.Range("X1", Range("X" & Rows.Count).End(xlUp))
For i = 1 To UBound(sn)
If sn(i, 1) <> vbNullString Then
tempArr = Split(sn(i, 1), " ")
If UBound(tempArr) >= 6 Then 'There must be a minimum of six spaces for the following code to work
For j = 0 To 6
tempArr2 = tempArr2 & tempArr(j) & " "
Next j
sn(i, 1) = tempArr2 & ".........."
End If
End If
If UBound(tempArr) >= 6 Then
tempArr2 = vbNullString
End If
Next i
ActiveSheet.Range("Y1").Resize(UBound(sn)) = sn
Application.ScreenUpdating = True
End Sub
Sub KeepLastSeven()
Dim sn, tempArr, tempArr2
Dim i As Long, j As Long
Application.ScreenUpdating = False
sn = ActiveSheet.Range("X1", Range("X" & Rows.Count).End(xlUp))
For i = 1 To UBound(sn)
If sn(i, 1) <> vbNullString Then
tempArr = Split(sn(i, 1), " ")
If UBound(tempArr) >= 6 Then 'There must be a minimum of six spaces for the following code to work
For j = UBound(tempArr) To LBound(tempArr) Step -1
If j = UBound(tempArr) - 6 - 1 Then 'Account for zero based array
Exit For
Else
tempArr2 = tempArr(j) & " " & tempArr2
End If
Next j
sn(i, 1) = ".........." & tempArr2
End If
End If
If UBound(tempArr) >= 6 Then
tempArr2 = vbNullString
End If
Next i
ActiveSheet.Range("Y1").Resize(UBound(sn)) = sn
Application.ScreenUpdating = True
End Sub
Note there must be at least two entries in Col. X or else the code will error out due to the upper limit of the sn array needing to be 1 or higher.
Thanks,
Robert
Bookmarks