Sub testme3()

Dim FName As String
Dim FNum As Long
Dim l As String
Dim l1 As Variant
Dim s As String
Dim sChr As String
Dim rng1 As Range, rng As Range
Dim cell As Range, iloc As Long

Columns("A:M").ClearContents
Columns(3).NumberFormat = _
"0000000000000"
FName = "C:\SLSRPT2.txt"

FNum = FreeFile

Open FName For Input As FNum
Line Input #FNum, s
s = Replace(s, Chr(9), "")
l = s
l = Replace(l, "LIN+", "LIN+,")
l = Replace(l, "LOC", "LIN+,,")
l = Replace(l, ":EN'QTY+17:", ",")
l = Replace(l, "::9'QTY+17:", ",17,")
l = Replace(l, "::9'QTY+83:", ",83,")
l = Replace(l, "::9'QTY+198:", ",198,")
l = Replace(l, "'", "")
' l = Replace(l, "+", ",")
l1 = Split(l, "LIN+")
Cells(1, 1).Resize(UBound(l1) - _
LBound(l1) + 1).Value = Application. _
Transpose(l1)
Close #FNum


Rows(1).Delete
Columns(1).Replace "++", ","
Columns(1).TextToColumns _
Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=True, _
Space:=False, _
Other:=False, _
FieldInfo:=Array( _
Array(1, 1), _
Array(2, 1), _
Array(3, 1), _
Array(4, 1))
Set rng2 = Range(Cells(1, 2), _
Cells(Rows.Count, 2).End(xlUp))
For Each cell In rng2.SpecialCells(xlConstants)
cell.Offset(0, -1).Delete Shift:=xlShiftToLeft
Next
Set cell = Cells(Rows.Count, "C").End(xlUp)
lastrow = cell.Row
If InStr(1, cell, "UNT", vbTextCompare) 0 Then
cell = Left(cell, InStr(1, cell, "UNT", vbTextCompare) - 1)
End If

For i = 1 To cell.Row
Set cell1 = Cells(i, "C")
If Len(Trim(cell1)) 5 Then
iloc = InStr(1, cell1, "+", vbTextCompare)
Do While iloc 0
cell1.Value = Mid(cell1, iloc + 1, 255)
iloc = InStr(1, cell1, "+", vbTextCompare)
Loop
If Right(cell1, 3) = "::9" Then
cell1.Value = Replace(cell1, "::9", "")
End If
Else
cell1.ClearContents
End If
Next
Set rng = Nothing
OldEan = ""
For i = 2 To lastrow
If Cells(i, 3) < "" Then
If Cells(i, 3) < OldEan Then
OldEan = Cells(i, 3)
firstrow = i
Else
If rng Is Nothing Then
Set rng = Cells(i, 3)
Else
Set rng = Union(rng, Cells(i, 3))
End If
End If
If CLng(Cells(i, "D")) = 17 Then
col = 8
ElseIf CLng(Cells(i, "D")) = 198 Then
col = 6
ElseIf CLng(Cells(i, "D")) = 83 Then
col = 7
End If
If Trim(Cells(i, "E")) < "" Then
Cells(firstrow, col) = Cells(i, "E")
Else
If rng Is Nothing Then
Set rng = Cells(i, "C")
Else
Set rng = Union(rng, Cells(i, "C"))
End If
End If
End If
Next
rng.EntireRow.Delete
Set rng = Columns(2).SpecialCells(xlBlanks)
rng.Formula = "=" & rng(1).Offset(-1, 0).Address(0, 0)
Set rng = Range(Cells(1, 2), _
Cells(Rows.Count, 2).End(xlUp))
rng.Formula = rng.Value
Set rng = Columns(3).SpecialCells(xlBlanks)
rng.EntireRow.Delete
Columns("D:E").Delete
Columns("A:A").Delete
Range("A1:E1").Value = Array( _
"EAN", "LOC", "QTY198", "QTY83", "QTY17")


End Sub

--
Regards,
Tom Ogilvy