Replace that one macro with these two, the second Function is used by the first to properly clean out any hidden junk.
Option Explicit
Sub SplitSpecial()
Dim SplitRNG As Range, StrSplit As Range
Dim SplitArr As Variant, SplitBuf As String
Dim SplitItem As Long, Codes As Long, Cnt As Long
Application.ScreenUpdating = False
Set SplitRNG = Range("A2:A" & Rows.Count).SpecialCells(xlCellTypeConstants)
For Each StrSplit In SplitRNG
SplitArr = Split(CleanAll(StrSplit), " ")
Cnt = 1
For SplitItem = LBound(SplitArr) To UBound(SplitArr)
If Len(SplitArr(SplitItem)) <> 7 Then
SplitBuf = SplitBuf & " " & SplitArr(SplitItem)
Else
StrSplit = Trim(SplitBuf)
SplitBuf = ""
For Codes = SplitItem To UBound(SplitArr)
StrSplit.Offset(0, Cnt) = SplitArr(Codes)
Cnt = Cnt + 1
Next Codes
Exit For
End If
Next SplitItem
Next StrSplit
Application.ScreenUpdating = True
End Sub
Function CleanAll(ByVal Txt As String) As String
Dim X As Long 'Code base by Rick Rothstein (MVP - Excel)
For X = 1 To Len(Txt)
If Mid(Txt, X, 1) Like "*[!A-Za-z0-9 ]*" Then Mid(Txt, X, 1) = Chr(1) ' Leave only numbers, letters and spaces
Next
CleanAll = Replace(Txt, Chr(1), "")
End Function
Bookmarks