Macro doubles the results

[1Ronin]

Hello,

I have a macro to extract test results from my files.

Test could be passed or failed. This macro is very fast, so try I use for large number of files to be processed.​

'Declared as global variables and can be used by any Sub and will retain their values
'So when you want to use it in the second it'll already contain the path picked up by the first
Dim Flink, Fname, Fadress As String, count As Integer

Private Sub CommandButton2_Click()
End Sub

'browse for short files
Private Sub CommandButton6_Click()
'Flink = Application.GetOpenFilename("All Files (*.*), *.*")            'all files
Flink = Application.GetOpenFilename("All Files (*.*cor), *.*cor") 'COR files
If Flink = False Then Exit Sub
TextBox1.Value = Flink
'take the name of file to remove to path to have only directory
Fname = Dir(Flink)
Fadress = Left(Flink, Len(Flink) - Len(Fname)) & "\*.*cor"
'MsgBox (Fadress)
Fname = Dir(Fadress)

'count of files
Do While Fname <> ""
count = count + 1
Fname = Dir()
Loop
'where to show no. of files
Label5.Caption = count

'End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const TestPlan = ""                     'all
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Sub Copyfromtext()
Dim Prod As Range, TestPlancc As String, s As Long, i As Long, TextFile() As String, ReadData As String, ValT As Variant, Code As Variant, NumOp As Variant, Pallet As Variant, X As Long, Y As Long, Val_All() As Variant
Dim StrFile As String, Fpath As String, Serie As String, DataB As String, Ora As String, Hour As Variant, Bench As String
Dim OP101 As Variant
Dim OP901 As Variant
Dim OP1 As Variant
Dim OP102 As Variant
Dim OP902 As Variant
Dim OP2 As Variant
Dim OP202 As Variant
Dim OP3 As Variant
Dim OP5 As Variant
Dim OP4 As Variant
Dim OP6 As Variant
Dim OP19 As Variant
Dim OP14 As Variant
Dim OP107 As Variant
Dim OP115 As Variant
Dim OP915 As Variant
Dim OP15 As Variant
Dim OP215 As Variant
Dim OP116 As Variant
Dim OP916 As Variant
Dim OP16 As Variant
Dim OP216 As Variant
Dim OP117 As Variant
Dim OP917 As Variant
Dim OP17 As Variant
Dim OP118 As Variant
Dim OP918 As Variant
Dim OP18 As Variant
Dim OP700 As Variant
Dim OP701 As Variant
Dim OP610 As Variant
Dim OP611 As Variant
Dim OP415 As Variant
Dim OP416 As Variant
Dim OP417 As Variant
Dim OP418 As Variant
Dim OP860 As Variant
Dim OP861 As Variant
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Time a section of VBA code using the Timer function
Dim secs1 As Single
Dim secs2 As Single
secs1 = Timer()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ReadData19 As Variant, ReadData0 As String, Previous As String

StrFile = Dir(Fpath)
Do While Len(StrFile) > 0
FilePath = Fpath & StrFile
StrFile = Dir

ReadData = ""
Rowc = Sheet1.Range("B" & Rows.count).End(xlUp).Row

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Open FilePath For Input As #1
Serie = ""
i = 0
j = 0
X = 0
Do Until EOF(1)
i = i + 1
Line Input #1, ReadData

If Previous = "NUM OP" Then
NumOp = Split(ReadData, ";")(0)
Previous = ""
End If
If Previous = "CODIGO" Then
Code = Split(ReadData, ";")(0)
Previous = ""
End If

'''SN
If i = 1 Then
Serie = Split(ReadData, ";")(8)
End If

'''Test plan
If i = 3 Then
TestPlancc = Split(ReadData, ";")(1)
If Left(Trim(TestPlancc), Len(TestPlan)) = TestPlan Then X = 1
End If

'''Date
If i = 5 Then
datacc = Split(ReadData, ";")(0)
DataB = Left(datacc, 2) & "." & Mid(datacc, 3, 2) & "." & Right(datacc, 4)
'DataB = DateSerial(Val(Right(datacc, 4)), Val(Left(Right(datacc, 6), 2)), Val(Left(datacc, 2)))
End If

'''Hour
If i = 5 Then
Ora = Split(ReadData, ";")(1)
Hour = Left(Ora, 2) & ":" & Mid(Ora, 3, 2) & ":" & Right(Ora, 2)
End If

'''Bench no.
If i = 1 Then
Bench = Split(ReadData, ";")(1)
End If

''Pallet no.
If i = 1 Then
Pallet = Split(ReadData, ";")(5)
End If


''Test data
If X = 1 Then

 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If UBound(Split(ReadData, ";")) >= 1 Then

'''CT
If InStr(1, Split(ReadData, ";")(0), "TIEMPO") > 0 Then ValT = Split(ReadData, ";")(1)

'''Code
If InStr(1, Split(ReadData, ";")(0), "CODIGO") > 0 Then Previous = "CODIGO"

'''NUM OP
If InStr(1, Split(ReadData, ";")(0), "NUM OP") > 0 Then Previous = "NUM OP"

End If ' UBound(Split(ReadData, ";")) >= 1

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'''Results. Col(19) = DATO!
'''Fill

If UBound(Split(ReadData, ";")) > 18 Then
ReadData0 = Split(ReadData, ";")(0)
'ReadData19 = CDbl(Split(ReadData, ";")(19))
ReadData19 = Split(ReadData, ";")(19)
On Error Resume Next
ReadData19 = CDbl(ReadData19)
On Error GoTo 0

If InStr(1, ReadData0, "000101") > 0 Then OP101 = ReadData19
If InStr(1, ReadData0, "000901") > 0 Then OP901 = ReadData19
If InStr(1, ReadData0, "000001") > 0 Then OP1 = ReadData19

'''
If InStr(1, ReadData0, "000102") > 0 Then OP102 = ReadData19
If InStr(1, ReadData0, "000902") > 0 Then OP902 = ReadData19
If InStr(1, ReadData0, "000002") > 0 Then OP2 = ReadData19
If InStr(1, ReadData0, "000202") > 0 Then OP202 = ReadData19

'''
If InStr(1, ReadData0, "000003") > 0 Then OP3 = ReadData19
If InStr(1, ReadData0, "000005") > 0 Then OP5 = ReadData19

'''
If InStr(1, ReadData0, "000004") > 0 Then OP4 = ReadData19
If InStr(1, ReadData0, "000006") > 0 Then OP6 = ReadData19

'''
If InStr(1, ReadData0, "000019") > 0 Then OP19 = ReadData19
If InStr(1, ReadData0, "000014") > 0 Then OP14 = ReadData19
If InStr(1, ReadData0, "000107") > 0 Then OP107 = ReadData19

'''
If InStr(1, ReadData0, "000115") > 0 Then OP115 = ReadData19
If InStr(1, ReadData0, "000915") > 0 Then OP915 = ReadData19
If InStr(1, ReadData0, "000015") > 0 Then OP15 = ReadData19
If InStr(1, ReadData0, "000215") > 0 Then OP215 = ReadData19

'''
If InStr(1, ReadData0, "000116") > 0 Then OP116 = ReadData19
If InStr(1, ReadData0, "000916") > 0 Then OP916 = ReadData19
If InStr(1, ReadData0, "000016") > 0 Then OP16 = ReadData19
If InStr(1, ReadData0, "000216") > 0 Then OP216 = ReadData19

'''
If InStr(1, ReadData0, "000117") > 0 Then OP117 = ReadData19
If InStr(1, ReadData0, "000917") > 0 Then OP917 = ReadData19
If InStr(1, ReadData0, "000017") > 0 Then OP17 = ReadData19

'''
If InStr(1, ReadData0, "000118") > 0 Then OP118 = ReadData19
If InStr(1, ReadData0, "000918") > 0 Then OP918 = ReadData19
If InStr(1, ReadData0, "000018") > 0 Then OP18 = ReadData19

'''
If InStr(1, ReadData0, "000700") > 0 Then OP700 = ReadData19
        If InStr(1, ReadData0, "000701") > 0 Then OP701 = ReadData19
 '''
If InStr(1, ReadData0, "000610") > 0 Then OP610 = ReadData19
If InStr(1, ReadData0, "000611") > 0 Then OP611 = ReadData19

'''
If InStr(1, ReadData0, "000415") > 0 Then OP415 = ReadData19
If InStr(1, ReadData0, "000416") > 0 Then OP416 = ReadData19
If InStr(1, ReadData0, "000417") > 0 Then OP417 = ReadData19
If InStr(1, ReadData0, "000418") > 0 Then OP418 = ReadData19

'''
If InStr(1, ReadData0, "000860") > 0 Then OP860 = ReadData19
If InStr(1, ReadData0, "000861") > 0 Then OP861 = ReadData19

End If ' UBound(Split(ReadData, ";")) >= 18

j = j + 1
End If ' X =1
Loop ' until EOF(1)
Close #1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''Copy
s = s + X
If s > 0 Then
ReDim Preserve Val_All(1 To 50, 1 To s)
Val_All(1, s) = Serie
Val_All(2, s) = DataB
Val_All(3, s) = Hour
Val_All(4, s) = Bench
Val_All(5, s) = TestPlancc
Val_All(6, s) = Code
Val_All(7, s) = NumOp
Val_All(8, s) = Pallet
Val_All(9, s) = ValT
Val_All(10, s) = OP101
Val_All(11, s) = OP901
Val_All(12, s) = OP1
Val_All(13, s) = OP102
Val_All(14, s) = OP902
Val_All(15, s) = OP2
Val_All(16, s) = OP202
Val_All(17, s) = OP3
Val_All(18, s) = OP5
Val_All(19, s) = OP4
Val_All(20, s) = OP6
Val_All(21, s) = OP19
Val_All(22, s) = OP14
Val_All(23, s) = OP107
Val_All(24, s) = OP115
Val_All(25, s) = OP915
Val_All(26, s) = OP15
Val_All(27, s) = OP215
Val_All(28, s) = OP116
Val_All(29, s) = OP916
Val_All(30, s) = OP16
Val_All(31, s) = OP216
Val_All(32, s) = OP117
Val_All(33, s) = OP917
Val_All(34, s) = OP17
Val_All(35, s) = OP118
Val_All(36, s) = OP918
Val_All(37, s) = OP18
Val_All(38, s) = OP700
Val_All(39, s) = OP701
Val_All(40, s) = OP610
Val_All(41, s) = OP611
Val_All(42, s) = OP415
Val_All(43, s) = OP416
Val_All(44, s) = OP417
Val_All(45, s) = OP418
Val_All(46, s) = OP860
Val_All(47, s) = OP861

    End If      '  s > 0

' ------------------------------  Status Bar   ----------------------------------
Fcount = Fcount + 1
Status.Caption = Round((Fcount / Label5.Caption) * 100, 1) & "% Completed"
Fill.Width = Fcount * (200 / Label5.Caption)
DoEvents
Loop            '  While Len(StrFile) > 0
    If s > 0 Then
Range("A" & Rowc + 1).Resize(s, 50).Value = Application.Transpose(Val_All)
'Range("B" & Rowc + 1).Resize(s, 1).NumberFormat = "dd/mm/yyyy"
'Range("C" & Rowc + 1).Resize(s, 1).NumberFormat = "hh:mm:ss"
End If


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Display the time difference
secs2 = Timer()
'''Variants for time
'MsgBox "" & secs2 - secs1 & " sec"
'MsgBox ("Time taken:" & vbNewLine & secs2 - secs1 & " seconds")
Label7.Caption = (secs2 - secs1)
'Display speed of processing files
Label9.Caption = Format((count / (secs2 - secs1)), "###0.00")

End Sub

'STOP button
Private Sub CommandButton3_Click()
'Unload Me
Application.SendKeys "^{BREAK}"
End Sub
'Remove_data (Reset)
Private Sub CommandButton4_Click()
Range("A2:AW65536").Select
Selection.ClearContents
Range("A2").Select
End Sub
Private Sub Label10_Click()
End Sub
Private Sub Label3_Click()
End Sub
Private Sub Label4_Click()
End Sub
Private Sub Label5_Click()
End Sub
Private Sub Label7_Click()
End Sub
Private Sub Label9_Click()
End Sub
Private Sub Status_Click()
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub UserForm_Click()
End Sub

The macro is working almost Ok, but has two errors.
1) First, there are issues in columns for Code & NumOp. This was solved by me using an additional macro that makes correction in the columns. In below picture Code = 33 and NumOp = 202 and both are correct.
2) The second error is not solved and will try to explain below:
- Let's say that I have 10 files to extract test results: 9 tests are pass and 1 test is fail.
- The test plan I use has let's say 20 parameters (I can select what to measure or not) to be measured and should extracted by macro
- For all 9 tests passed macro will give me 20 values/file
- For 1 test fail (due to various reasons) I will have less values than 20. Let's say we have only 7 parameters recorded (in blue), because test was stopped.
- Now if the FAIL test is the first file to be processed, I have only 7 results and the rest of cells till 20 are empty
- If the FAIL test is not the first file processed, the macro will fill the cells with the 7 results and also the rest till 20 with results from previous file (in red). This is giving me wrong data...

I upload also an image where you can see the issue. Red numbers from right side are doubled.

Is like the macro don't find all expected data and fill with results from previous file. This is not Ok.
Sorry for large post.
Many thanks in advance for any help.

Regards.