PDA

View Full Version : Please Help with VBA code



Anirban
04-15-2016, 07:14 AM
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)


15928
Sample file in the File.ZIP

Bob Phillips
04-15-2016, 09:25 AM
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
04-23-2016, 02:21 AM
URGENT HELP REQUIREDClearly not the same urgency to say 'Thank-you'.

Aussiebear
04-23-2016, 09:06 PM
Thank you XLD

Bob Phillips
04-24-2016, 01:25 AM
You're welcome Mr Bear!