Importing Report with Formatting issues

[Dflycon1]

I may have bitten off more than I can chew with a project at work, could use some expert help.

There is a text report generated that we want in a clean excel format.

The issue is, for me at least, there is no simple repeating tag and it gets paginated headers at length intervals.

I'm trying to brute force select and clear rows, then I'll text to columns with the remaining data.

Easier to look at the data probably, I've attached a sample.

Here is the code I've tried so far, it just seems like it's going to take forever this way :


Sub cleancyclecount()
Dim VarCase As Range
Dim UsedRng As Range
Set UsedRng = ActiveSheet.UsedRange
'Bad Cases
For Each VarCase In UsedRng
If Left(VarCase.Value, 6) = "Funct:" Or Left(VarCase.Value, 13) = " 1 Cycle Wave" Or Left(VarCase.Value, 17) = " 2 Date Completed" _
Or Right(VarCase.Value, 12) = "KR01 Page: 1" Or Left(VarCase.Value, 6) = " 1 TWL" Or Left(VarCase.Value, 8) = " 2 Input" Or _
Left(VarCase.Value, 13) = " 3 Cycle Type" Or Left(VarCase.Value, 12) = " Company:" Or Left(VarCase.Value, 13) = " Warehouse" _
Then
VarCase.ClearContents
' VarCase.Offset(0, 1).Value = "0"
' Else: VarCase.Offset(0, 1).Value = "1"
End If
Next
End Sub


I also need to add a new column with the data and wave, which appears in the next to the data blocks.

I'll probably get a brute force method working eventually, but I've hit a wall.

Any insight or help would be a life saver.

[Paul_Hossler]

what do you want the final report to look like?

The sample has a lot of headers and blank lines

[Dflycon1]

I know, too many headers!

We're trying to get to here :



Location
Item
Empl.
Before
After
Wave
Date


F04AB9
10000413
jjh01
64
64
3258
1/4/2023


M48D5-02
10000413
SM001
29
33
3258
1/4/2023


M05AD1-02
10010021
jjh01
1
1
3258
1/4/2023


F06AM7
10010160
KG001
2
2
3258
1/4/2023


M52G5-04
10010160
jjh01
5
5
3258
1/4/2023


M22AA2-02
10012176
jjh01
4
4
3258
1/4/2023


F04AA8
10014587
KG001
2
2
3258
1/4/2023


M50B1-01
10014587
SM001
6
6
3258
1/4/2023


M42AB1-03
10015919
SM001
1
1
3258
1/4/2023


F03BB7
10018921
jjh01
13
13
3258
1/4/2023


M15ZC8
10018921
jjh01
24
24
3258
1/4/2023

[georgiboy]

Not sure why but i saw this as a challenge i wanted to complete with a formula, just thought i would share, if you don't have Excel 365 then it will not work for you.


=LET(
d,A1:A531,
line,TAKE(FILTER(d,ISNUMBER(SEARCH("Date Completed",d))),-1),
wave,--TEXTAFTER(TEXTBEFORE(line,"Cycle Type"),": "),
date,--TEXTAFTER(line,": ",-1),
data,TRIM(DROP(FILTER(d,(ISNUMBER(--RIGHT(d,1)))*(LEFT(d,14)<>" Cycle Wave")*(LEFT(d,12)<>" Location")*(LEFT(d,1)<>CHAR(12))*(LEFT(d,5)<>" ")),1))&" "&wave&" "&date,
xml,"<t><s>"&SUBSTITUTE(data," ","</s><s>")&"</s></t>",
f,FILTERXML(xml,"//s["&SEQUENCE(,7)&"]"),
VSTACK({"Location","Item","Empl","Before","After","Wave","Date"},f)
)

[Paul_Hossler]

I got the impression that the data is pulled from another system as text file, so I moved TextData.xlsx into a text file (attached, but rename to just txt). Easy enough to change if it's not

BTW, a lot of data cleanup is always required for reports pulled from another system

This asks for the text file and makes a worksheet ("Report") with what I think is your format

Did not do any formatting on Report, could be added



Option Explicit

Sub Suggestion()
Dim txtFilename As String, txtLine As String
Dim rptWS As Worksheet
Dim txtHandle As Long
Dim rptRow As Long
Dim txtLineSplit As Variant
Dim i As Long
Dim rptWave As Long, rptDate As Date
'get text file
txtFilename = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Select Txt File")
If txtFilename = "False" Then Exit Sub
'make new ws
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Report").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Worksheets.Add.Name = "Report"
Set rptWS = Worksheets("Report")
rptRow = 1
With rptWS
.Cells(rptRow, 1).Value = "Location"
.Cells(rptRow, 2).Value = "Item"
.Cells(rptRow, 3).Value = "Empl"
.Cells(rptRow, 4).Value = "Before"
.Cells(rptRow, 5).Value = "After"
.Cells(rptRow, 6).Value = "Wave"
.Cells(rptRow, 7).Value = "Date"
End With
rptRow = rptRow + 1
'open text file
txtHandle = FreeFile
Open txtFilename For Input As #txtHandle
'read each line
Do While Not EOF(txtHandle)
Line Input #txtHandle, txtLine
With Application.WorksheetFunction
txtLine = .Substitute(txtLine, Chr(34), "")
'non-printable characters NOT caught by CLEAN
txtLine = .Substitute(txtLine, Chr(160), Chr(32)) ' non-breaking space
txtLine = .Substitute(txtLine, Chr(127), Chr(7)) ' ASCII 7 = BEL char
txtLine = .Substitute(txtLine, Chr(129), Chr(7))
txtLine = .Substitute(txtLine, Chr(141), Chr(7))
txtLine = .Substitute(txtLine, Chr(143), Chr(7))
txtLine = .Substitute(txtLine, Chr(144), Chr(7))
txtLine = .Substitute(txtLine, Chr(157), Chr(7))
'remove leading, trailing, multiple spaces (inc. what was 160's)
txtLine = .Trim(txtLine)
'remove 0 - 31 (inc. what was 127, 129, 141, 143, 144, and 157)
txtLine = .Clean(txtLine)
txtLine = .Substitute(txtLine, ",", "")
txtLine = .Substitute(txtLine, ".00", "")
txtLine = .Substitute(txtLine, Chr(34), "")
End With
'Cycle Wave: 2767 Cycle Type: Wave Date Completed: 01/04/2023
'remember wave and date
If InStr(txtLine, "Cycle Wave") > 0 Then
txtLineSplit = Split(txtLine, " ")
rptWave = CLng(txtLineSplit(2))
rptDate = CDate(txtLineSplit(8))
End If
If Len(txtLine) = 0 Then GoTo NextLine
If Left(txtLine, 1) = "-" Then GoTo NextLine
If Left(txtLine, 1) = "_" Then GoTo NextLine
If InStr(txtLine, "Column") > 0 Then GoTo NextLine
If InStr(txtLine, "Accuracy") > 0 Then GoTo NextLine
If InStr(txtLine, "Wave") > 0 Then GoTo NextLine
If InStr(txtLine, "From") > 0 Then GoTo NextLine
If InStr(txtLine, "Location") > 0 Then GoTo NextLine
If InStr(txtLine, "Wave") > 0 Then GoTo NextLine
If InStr(txtLine, "Server") > 0 Then GoTo NextLine
txtLine = UCase(txtLine)
txtLineSplit = Split(txtLine, " ")
For i = LBound(txtLineSplit) To UBound(txtLineSplit) ' starts at 0
rptWS.Cells(rptRow, i + 1).Value = txtLineSplit(i)
Next i
rptWS.Cells(rptRow, 6).Value = rptWave
rptWS.Cells(rptRow, 7).Value = rptDate
rptRow = rptRow + 1
NextLine:
Loop
'close
Close #txtHandle
MsgBox "Done"
End Sub

[Dflycon1]

That's really cool!

Doesn't work on the full data set, so I'm including it here.

The sample I gave before only had one wave and date, so this is a better representation.

This is a default transformation of a text file into excel, so maybe there is a good way to use power query. I tried to upload the .txt but the forum errored out, I assume it was too big.

31161

[Paul_Hossler]

That's really cool!

I tried to upload the .txt but the forum errored out, I assume it was too big.



Do like I did and make the extension .txt.csv​ since thr forum likes CSV files

[Paul_Hossler]

I zipped the txt file

[Dflycon1]

Ok, you're a mind reader.

This is exactly what I've been trying to do.

Thanks for the data import handler, I could have put that in but you saved me an incredible amounts of steps anyway.

Here is a raw txt file, zipped.

I made some improvements based on other edge cases too, and now I'm just trying to add back in Pallet, because I didn't realize that was in the data blocks too bc it's so infrequent.


Option Explicit

Sub Suggestion()
Dim txtFilename As String, txtLine As String
Dim rptWS As Worksheet
Dim txtHandle As Long
Dim rptRow As Long
Dim txtLineSplit As Variant
Dim i As Long
Dim rptWave As Long, rptDate As Date
'get text file
txtFilename = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Select Txt File")
If txtFilename = "False" Then Exit Sub
'make new ws
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Report").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Worksheets.Add.Name = "Report"
Set rptWS = Worksheets("Report")
rptRow = 1
With rptWS
.Cells(rptRow, 1).Value = "Location"
'added Pallet
.Cells(rptRow, 2).Value = "Pallet"
.Cells(rptRow, 3).Value = "Item"
.Cells(rptRow, 4).Value = "Empl"
.Cells(rptRow, 5).Value = "Before"
.Cells(rptRow, 6).Value = "After"
.Cells(rptRow, 7).Value = "Wave"
.Cells(rptRow, 8).Value = "Date"
End With
rptRow = rptRow + 1
'open text file
txtHandle = FreeFile
Open txtFilename For Input As #txtHandle
'read each line
Do While Not EOF(txtHandle)
Line Input #txtHandle, txtLine
With Application.WorksheetFunction
txtLine = .Substitute(txtLine, Chr(34), "")
'non-printable characters NOT caught by CLEAN
txtLine = .Substitute(txtLine, Chr(160), Chr(32)) ' non-breaking space
txtLine = .Substitute(txtLine, Chr(127), Chr(7)) ' ASCII 7 = BEL char
txtLine = .Substitute(txtLine, Chr(129), Chr(7))
txtLine = .Substitute(txtLine, Chr(141), Chr(7))
txtLine = .Substitute(txtLine, Chr(143), Chr(7))
txtLine = .Substitute(txtLine, Chr(144), Chr(7))
txtLine = .Substitute(txtLine, Chr(157), Chr(7))
'remove leading, trailing, multiple spaces (inc. what was 160's)
txtLine = .Trim(txtLine)
'remove 0 - 31 (inc. what was 127, 129, 141, 143, 144, and 157)
txtLine = .Clean(txtLine)
txtLine = .Substitute(txtLine, ",", "")
txtLine = .Substitute(txtLine, ".00", "")
txtLine = .Substitute(txtLine, Chr(34), "")
End With
'Cycle Wave: 2767 Cycle Type: Wave Date Completed: 01/04/2023
'remember wave and date
If InStr(txtLine, "Cycle Wave:") > 0 Then
txtLineSplit = Split(txtLine, " ")
rptWave = CLng(txtLineSplit(2))
rptDate = CDate(txtLineSplit(8))
End If
If Len(txtLine) = 0 Then GoTo NextLine
If Left(txtLine, 1) = "-" Then GoTo NextLine
If Left(txtLine, 1) = "_" Then GoTo NextLine
If InStr(txtLine, "Column") > 0 Then GoTo NextLine
If InStr(txtLine, "Accuracy") > 0 Then GoTo NextLine
If InStr(txtLine, "Wave") > 0 Then GoTo NextLine
If InStr(txtLine, "From") > 0 Then GoTo NextLine
If InStr(txtLine, "Location") > 0 Then GoTo NextLine
If InStr(txtLine, "Wave") > 0 Then GoTo NextLine
If InStr(txtLine, "Server") > 0 Then GoTo NextLine
'New edge cases added
If InStr(txtLine, "Company") > 0 Then GoTo NextLine
If InStr(txtLine, "Warehouse") > 0 Then GoTo NextLine
If InStr(txtLine, "**") > 0 Then GoTo NextLine
If InStr(txtLine, "Funct") > 0 Then GoTo NextLine
If InStr(txtLine, "Ranges") > 0 Then GoTo NextLine
If InStr(txtLine, "Options") > 0 Then GoTo NextLine
If InStr(txtLine, "(D)ata") > 0 Then GoTo NextLine
If InStr(txtLine, "(D)aily") > 0 Then GoTo NextLine
If InStr(txtLine, "TWL") > 0 Then GoTo NextLine
txtLine = UCase(txtLine)
txtLineSplit = Split(txtLine, " ")
For i = LBound(txtLineSplit) To UBound(txtLineSplit) ' starts at 0
rptWS.Cells(rptRow, i + 1).Value = txtLineSplit(i)
Next I
rptWS.Cells(rptRow, 7).Value = rptWave
rptWS.Cells(rptRow, 8).Value = rptDate
rptRow = rptRow + 1
NextLine:
Loop
'close
Close #txtHandle
End Sub

[Paul_Hossler]

Added Pallet column

Deleted some of your tests since they were redundant

Broke some logic out to 3 private subs

Added little bit of formatting to Report sheet

[p45cal]

Another way, with Power Query.
The way this works is by clicking the button at cell D1 which (using code stolen from Paul) let's you choose the file you want to process and refreshes the Power Query table below the button.
I've left the Type column in; it might be useful but it's easily removed.
While comparing the results, many of the dates came out differently, probably because I'm in the UK with D/M/Y dates and not in the states with M/D/Y dates, so I changed Paul's code from

rptDate = CDate(txtLineSplit(8))to:
myDate = Split(txtLineSplit(8), "/")
rptDate = DateSerial(myDate(2), myDate(0), myDate(1)) which will work wherever you are in the world.
What was pleasantly surprising was that of the 15k rows of results, only 20 or so were different, with Power Query producing one extra row (highlighted in yellow in column A around row 14849).
Most of the differences were around the splitting of the data to the first 2 columns - I didn't try to identify which was more correct.
There were 2 or 3 rows where the Before and After values were different, but there are a few lines in the source file where it's nigh on impossible to work out what should be in there.