Import long string (modified Tom O snippet help!)
Hi Tom,
been looking at the results and found the following
'LIN+1++21298776:EN'QTY+17:1'LOC+14+5023949771634: :9'QTY+198:0'LOC+14+5023949771634::9'QTY+83:0'LOC+ 14+5023949771634::9
If you look at the line above it appears that the QTY+17 immediately after
the :EN is related to the next LOC...
So they appear to have a text format like :
LIN - EAN - QTY17 - LOC - QTY198 - LOC - QTY83 - LOC
They appear to be giving the values in the QTY followed by the LOC,
When i ran the code it was out on the QTY17 by one place each time. This
became very apparant when LOC+14 (Store) and LOC+18 (Warehouse) was
displayed.
Also noticed that the LOC column still included the prefix (which i would
prefer to strip and just leave the 13 digit code)
=14+ (store identifier)
=18+ (Warehouse identifier)
Looking at the code i assume that the line l = Replace(l, ":EN'QTY+17:",
",") and the
would have to be modified. Also it makes it more complicated when multiple
locations have a product as then i also have l = Replace(l, "::9'QTY+17:",
",17,") to contend with.
Does this make sense ? I can see what i mean, just not sure i explained it
very well...
Brian
"Tom Ogilvy" wrote in message
...
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
|