Looping through the excel cells

[nisdey]

i am trying to get a excel result in a proper format but i am so confused in the looping and the condition and tried all night long and still not able to figure it out. Easy structure but complex coding, If possible it would be better if the code is VBscript friendly. Thanks


Actual table from the code below:

[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]E1[/TD]
[TD]E2[/TD]
[TD]E1[/TD]
[/TR]
[TR]
[TD]ABC[/TD]
[TD]Fail[/TD]
[TD]Pass[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]XYZ[/TD]
[TD]Pass[/TD]
[TD]Fail[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: grid, width: 500"]
<tbody></tbody>[/TABLE]


Output table expected is:
> E1 E2
> ABC P F
> PQR F P
> Xyz P P

[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]E1[/TD]
[TD]E2[/TD]
[/TR]
[TR]
[TD]ABC[/TD]
[TD]pass[/TD]
[TD]fail[/TD]
[/TR]
[TR]
[TD]PQR[/TD]
[TD]Fail[/TD]
[TD]PAss
[/TD]
[/TR]
[TR]
[TD]XYZ[/TD]
[TD]Pass[/TD]
[TD]PAss[/TD]
[/TR]
</tbody>[/TABLE]



Text file: I have 6 of these files
> Env>E1
> TestName>ABC
> Result>P


Below is the code:




Public Sub Temp()
ThisWorkbook.Sheets(1).Range("a1:D10").ClearContents
Dim MyObj As Object, MySource As Object, file As Variant
Set MyObj = CreateObject("Scripting.FileSystemObject")
Set MySource = MyObj.GetFolder("C:\Users\admin\Desktop\looping\xmlfile")
For Each file In MySource.Files
If InStr(file.Name, "txt") > 0 Then
'myFile = file.Path
fileSpec = file.Path '"C:\Prac_Session\OLB.xml" 'change the path to whatever yours ought to be
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTS = objFSO.OpenTextFile(fileSpec, ForReading)
rowupdate = 1
colupdate = 1
Open fileSpec For Input As #1
Do Until EOF(1)
Line Input #1 , textline
''debug.Print textline
If InStr(textline, "TestName>") > 0 Then 'Read line by line and store all lines in strContents
For rw = 2 To 4
If Sheet1.Cells(rw, 1) <> Mid(textline, 10, Len(textline) - 9) Then
If Sheet1.Cells(rw, 1) = "" Then
Sheet1.Cells(rw, 1).Value = Mid(textline, 10, Len(textline) - 9)
rowupdate = rw
Exit For
ElseIf Sheet1.Cells(rw, 1) = Mid(textline, 10, Len(textline) - 9) Then
rowupdate = rw
Exit For
ElseIf Sheet1.Cells(rw, 1) <> Mid(textline, 10, Len(textline) - 9) Then
Sheet1.Cells(rw + 1, 1) = Mid(textline, 10, Len(textline) - 9)
rowupdate = rw
Exit For
End If
End If
Next
End If
If InStr(textline, "Env>") > 0 Then 'Read line by line and store all lines in strContents
For col = 2 To 3
If Sheet1.Cells(1, col) <> Mid(textline, 5, Len(textline) - 4) Then
If Sheet1.Cells(1, col) = "" Then
Sheet1.Cells(1, col).Value = Mid(textline, 5, Len(textline) - 4)
colupdate = col
Exit For
ElseIf Sheet1.Cells(1, col).Value = Mid(textline, 5, Len(textline) - 4) Then
colupdate = col
Exit For
ElseIf Sheet1.Cells(1, col) <> Mid(textline, 5, Len(textline) - 4) Then
Sheet1.Cells(1, col + 1) = Mid(textline, 5, Len(textline) - 4)
colupdate = col
Exit For
End If
End If
Next
End If
If InStr(textline, "Result>") > 0 Then 'Read line by line and store all lines in strContents
Sheet1.Cells(rowupdate, colupdate).Value = Mid(textline, 8, Len(textline) - 7)
rowupdate = 1
colupdate = 1
End If
Loop
Close #1
End If
Next file
End Sub

 

[pbornemeier]

This is your expected output:

E1 E2 
ABC pass fail 
PQR Fail PAss 
XYZ Pass PAss

I believe this is part of one of your input files:

> Env>E1
 > TestName>ABC
 > Result>P

'E1' is in the (presumed) input file, but 'E2' is not.

Both of the blocks above were copied from your post, but changed when I pasted them.
What would be the input file that gave you that output if your code was working as you designed?
Does the input file contain tabs or any whitespace other than spaces?
Are there any spaces to the left of the first character of each line in the input files?

It appears as if the code will overwrite output cells as each file is processed. I doubt this is the desired result. How should the second and subsequent files be shown on the output worksheet?

This is your code indented and using CODE tags - makes it easier to see. I added some error checking code as Else statements in the For-Next loops. If they trigger, you will have to add more processing code.

Public Sub Temp()

    ThisWorkbook.Sheets(1).Range("a1:D10").ClearContents
    
    Dim MyObj As Object, MySource As Object, file As Variant
    Dim fileSpec As String
    Dim objFSO As Object, objTS As Object
    Dim rowupdate As Long, colupdate As Long
    Dim textline As String
    Dim rw As Long
    Dim col As Long
    Const ForReading As Long = 1
    
    Set MyObj = CreateObject("Scripting.FileSystemObject")
    Set MySource = MyObj.GetFolder("C:\Users\admin\Desktop\looping\xmlfile")
    
    For Each file In MySource.Files
        If InStr(file.Name, "txt") > 0 Then
            'myFile = file.Path
            fileSpec = file.Path '"C:\Prac_Session\OLB.xml" 'change the path to whatever yours ought to be
            Set objFSO = CreateObject("Scripting.FileSystemObject")
            Set objTS = objFSO.OpenTextFile(fileSpec, ForReading)
            rowupdate = 1
            colupdate = 1
            Open fileSpec For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
            Do Until EOF(1)
                Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , textline
                ''debug.Print textline
                If InStr(textline, "TestName>") > 0 Then 'Read line by line and store all lines in strContents
                    For rw = 2 To 4
                        If Sheet1.Cells(rw, 1) <> Mid(textline, 10, Len(textline) - 9) Then
                            If Sheet1.Cells(rw, 1) = "" Then
                                Sheet1.Cells(rw, 1).Value = Mid(textline, 10, Len(textline) - 9)
                                rowupdate = rw
                                Exit For
                            ElseIf Sheet1.Cells(rw, 1) = Mid(textline, 10, Len(textline) - 9) Then
                                rowupdate = rw
                                Exit For
                            ElseIf Sheet1.Cells(rw, 1) <> Mid(textline, 10, Len(textline) - 9) Then
                                Sheet1.Cells(rw + 1, 1) = Mid(textline, 10, Len(textline) - 9)
                                rowupdate = rw
                                Exit For
                            End If
                        End If
                    Next
                End If
                If InStr(textline, "Env>") > 0 Then 'Read line by line and store all lines in strContents
                    For col = 2 To 3
                        If Sheet1.Cells(1, col) <> Mid(textline, 5, Len(textline) - 4) Then
                            If Sheet1.Cells(1, col) = "" Then
                                Sheet1.Cells(1, col).Value = Mid(textline, 5, Len(textline) - 4)
                                colupdate = col
                                Exit For
                            ElseIf Sheet1.Cells(1, col).Value = Mid(textline, 5, Len(textline) - 4) Then
                                colupdate = col
                                Exit For
                            ElseIf Sheet1.Cells(1, col) <> Mid(textline, 5, Len(textline) - 4) Then
                                Sheet1.Cells(1, col + 1) = Mid(textline, 5, Len(textline) - 4)
                                colupdate = col
                                Exit For
                            End If
                        End If
                    Next
                End If
                If InStr(textline, "Result>") > 0 Then 'Read line by line and store all lines in strContents
                    Sheet1.Cells(rowupdate, colupdate).Value = Mid(textline, 8, Len(textline) - 7)
                    rowupdate = 1
                    colupdate = 1
                End If
            Loop
            Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
        End If
    Next file
End Sub