Function piece(Searchstring As String, Separator As String, IndexNum As Integer) As String
Dim t
t = Split(Searchstring, Separator)
If UBound(t) > 0 Then piece = t(IndexNum - 1)
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rownum As Integer
Dim dchr As Variant
Application.ScreenUpdating = False
If Not Intersect(Range("a2:a1000000"), Target) Is Nothing Then
rownum = Target.Row
Else: Exit Sub
End If
Cancel = True
'On Error GoTo errhandler
dchr = Left(Range("a" & rownum).Offset(1, 0), 1)
If dchr = ";" Then
ActiveCell.ClearContents
End If
Range("a" & rownum).TextToColumns Destination:=Range("b" & rownum), DataType:=xlDelimited, _
TextQualifier:=xlSingleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="%", FieldInfo:=Array(Array(1, 9), Array(2, 2)), TrailingMinusNumbers:=True
Range("b" & rownum).TextToColumns Destination:=Range("G" & rownum), DataType:=xlDelimited, _
TextQualifier:=xlSingleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="^", FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 9)), _
TrailingMinusNumbers:=True
Range("G" & rownum).TextToColumns Destination:=Range("k" & rownum), DataType:=xlFixedWidth, _
OtherChar:="^", FieldInfo:=Array(Array(0, 2), Array(2, 2)), _
TrailingMinusNumbers:=True
Range("H" & rownum).TextToColumns Destination:=Range("N" & rownum), DataType:=xlDelimited, _
TextQualifier:=xlSingleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="$", FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 9), Array(4, 1)), _
TrailingMinusNumbers:=True
Range("p" & rownum).Value = Date
Range("q" & rownum).Value = Time
'errhandler:
Application.ScreenUpdating = True
End Sub
Bookmarks