Public Temp As String
Sub Macro1()
LR = Cells(Rows.Count, 1).End(xlUp).Row
With Range("B2:B" & LR)
.FormulaR1C1 = "=test(RC[-1])"
.Value = .Value
End With
Range("A:A").Delete
Range("A2:A" & LR).TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _
, 1), Array(13, 1), Array(14, 1), Array(15, 1)), TrailingMinusNumbers:=True
End Sub
Function Test(A As String)
Temp = A
Temp = Pass("a:")
Test = Pass("p:")
End Function
Function Pass(T As String)
Temp = Replace(Temp, T, T & "|")
TextA = Split(Temp, T & "|")
For Count = 0 To UBound(TextA)
TT = TextA(Count)
'********************************************************************************************
' Look Wholly Numeric Entry.
Flag = True
For Count1 = 1 To Len(TT)
If Not IsNumeric(Mid(TT, Count1, 1)) And Mid(TT, Count1, 1) <> ":" Then Flag = False
Next
If Flag = True Then TextA(Count) = TextA(Count) & T: GoTo Skip
'********************************************************************************************
' Look for Time at End.
APos = Len(TT)
TimeLoop:
If IsNumeric(Mid(TT, APos, 1)) Or Mid(TT, APos, 1) = ":" Then APos = APos - 1: GoTo TimeLoop
If Not IsNumeric(Mid(TT, APos - 1, 1)) Then
'Date At End
Ltext = Left(TT, APos)
Rtext = Right(TT, Len(TT) - APos)
TextA(Count) = Ltext & "|" & Rtext & T
GoTo Skip
End If
'********************************************************************************************
' Look for Postcode With Space at End.
Check = Replace(Right(TT, 7), " ", "")
Flag = True
For CheckLoop = 1 To 5 Step 2
If IsNumeric(Mid(Check, CheckLoop, 1)) Or Not IsNumeric(Mid(Check, CheckLoop + 1, 1)) Then Flag = False
Next
If Flag = True Then
'Postcode at End Of Entry
GoTo Skip
End If
'********************************************************************************************
' Look for Postcode Without Space at End.
Check = Right(TT, 6)
Flag = True
For CheckLoop = 1 To 5 Step 2
If IsNumeric(Mid(Check, CheckLoop, 1)) Or Not IsNumeric(Mid(Check, CheckLoop + 1, 1)) Then Flag = False
Next
If Flag = True Then
'Postcode at End Of Entry
TextA(Count) = Left(TT, Len(TT) - 3) & " " & Right(TT, 3)
GoTo Skip
End If
'********************************************************************************************
'Look for Postcode with space & Time
SpaceCount = Len(TT) - Len(Replace(TT, " ", ""))
Temp = Application.Substitute(TT, " ", "|", SpaceCount - 1)
Check = Replace(Right(Temp, Len(Temp) - InStr(Temp, "|")), " ", "")
Flag = True
For CheckLoop = 1 To 5 Step 2
If IsNumeric(Mid(Check, CheckLoop, 1)) Or Not IsNumeric(Mid(Check, CheckLoop + 1, 1)) Then Flag = False
Next
If Flag = True Then
'Postcode at End Of Entry
TT = Application.Substitute(TT, " ", "|", SpaceCount - 1)
Ltext = Left(TT, InStr(TT, "|") - 1) & " " & Mid(TT, InStr(TT, "|") + 1, 7) & "|"
Rtext = Right(TT, Len(TT) - Len(Ltext) + 1)
TextA(Count) = Ltext & Rtext & T
GoTo Skip
End If
Skip:
Next
Pass = Join(TextA, "|")
End Function
Bookmarks