Please Help with VBA code

[Anirban]

URGENT HELP REQUIRED
... I am VBA noob

My requirement is simple. I need to open the attached FILE.TXT file by the button click and read through each line of file.
Whenever I find the word "polisnummer", I write value of the policy in cell A6 & then the value of "attribuut" in cell B6, the the value of "waarde" in cell C6 & the the value of " foutmelding " in cell D6.

Once the next " polisnummer " string is found, I fill similarly in cell A7,B7,C7,D7....and so on (as evident from the excel)


img.JPG
Sample file in the File.ZIP

[Bob Phillips]

Public Sub ImportText()
Dim this As Worksheet
Dim txtFile As Workbook
Dim cell As Range
Dim firstaddress As String
Dim nextrow As Long

    Set this = ActiveSheet
    nextrow = 6
    
    With Application.FileDialog(msoFileDialogOpen)
    
        .AllowMultiSelect = False
        .InitialFileName = "File.txt"
        If .Show = -1 Then
        
            Workbooks.OpenText Filename:=.SelectedItems(1), _
                                             DataType:=xlDelimited, _
                                             Tab:=True
                                             
            With ActiveWorkbook
            
                With .Worksheets(1).Columns(1)
            
                    Set cell = .Find("Polisnummer", LookIn:=xlValues)
                    If Not cell Is Nothing Then
                    
                        firstaddress = cell.Address
                        Do
                        
                            this.Cells(nextrow, "B").Value = Trim(Replace(cell.Value, "Polisnummer", ""))
                            this.Cells(nextrow, "C").Value = Trim(Replace(cell.Offset(2, 0).Value, "Attribuut", ""))
                            this.Cells(nextrow, "D").Value = Trim(Replace(cell.Offset(3, 0).Value, "Waarde", ""))
                            this.Cells(nextrow, "E").Value = Trim(Replace(cell.Offset(4, 0).Value, "Foutmelding", ""))
                            
                            Set cell = .FindNext(cell)
                            nextrow = nextrow + 1
                        Loop While Not cell Is Nothing And cell.Address <> firstaddress
                        
                    End If
                End With
                
                .Close SaveChanges:=False
            End With
        End If
    End With
End Sub

[p45cal]

URGENT HELP REQUIRED

Clearly not the same urgency to say 'Thank-you'.

[Aussiebear]

Thank you XLD

[Bob Phillips]

You're welcome Mr Bear!