none
Excel VBA read in text file and compare string RRS feed

  • Question

  • Hello, I am trying to read 3 text files into Excel. Each text file contains 3 columns of text (sometimes there is no text in the 3rd column. The file format would look like:

    file 1

    a 10

    b 5

    c 4

    file 2

    a 11

    c 16

    e 10

    file 3

    b 3 value can be changed

    c 0

    a 5

    So I would end up with:

    worksheet

    a 10 11 5

    b 5  'blank' b 3 value can be changed

    c 4 16 0

    e 'blank' 10 'blank'

    In the example, the 3rd file "value can be changed" needs to be concatenated, which I have managed. I have also managed to use "split" function to break down the string. The files may contain different ranges and are not always in the same order. Once the 1st file is read in and written to cells; I would like to read in the second file and compare it to the first set of data. I can read in the files but the data is overwritten in the first columns. I am not that well versed in VBA (and I am not a software developer). After watching various youtube videos and reading online articles, I VBA code is as follows:

    Sub text1()
    ' declarations
    Dim objFSO, strFile, objTextFile
    Dim ws As Worksheet
    Dim nextRow As Integer, FinalRow As Integer ', FinalCol As Integer
    ' set files path
        chdir (Application.ActiveWorkbook.Path)
    ' set objects
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set ws = Worksheets(1)
        Cells(1, 1).Value = "Options"
    ' Set up list of file filters
        Filt = "Text Files (*.txt),*.txt"
    ' Set the dialog box caption
        Title = "Select Files to Import"
    ' Get the files
        strFile = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title, MultiSelect:=True)
    ' Exit if dialog box cancelled
        If Not IsArray(strFile) Then
            MsgBox "No files were selected."
            Exit Sub
        End If
    ' Display full path and name of the files
        For j = LBound(strFile) To UBound(strFile)
            MsgBox "You selected " & vbCrLf & strFile(j)
            Cells(1, j + 1).Value = Right(strFile(j), 8)
    ' initialise row each time through loop
            nextRow = 2
            Set objTextFile = objFSO.OpenTextFile(strFile(j), 1)
     ' loop through text file
            Do Until objTextFile.AtEndOfStream
                line = objTextFile.ReadLine()
                myLine = Split(line, " ")
                For i = 0 To UBound(myLine)
                    If i = 2 Then
                        If IsNumeric(Left(myLine(i), 1)) = True Then
    ' one of the files has a rough space in column 2 followed by IP address. This concaternates it before writing
                            Cells(nextRow, 2).Value = myLine(i - 1) & myLine(i)
                            Exit For
                        ElseIf Left(myLine(i), 1) = "(" Then
    ' status value in 3rd column "value can be changed" is concaternated before writing
                            Cells(nextRow, UBound(strFile) + 2).Value = myLine(i) & " " & myLine(i + 1) & " " & myLine(i + 2) & " " & myLine(i + 3)
                            Exit For
                        End If
                    End If
                    Cells(nextRow, i + 1).Value = myLine(i)
                Next i
                nextRow = nextRow + 1
            Loop
    ' sort into accending order after insertion after each pass
            'FinalRow = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
            Rem FinalCol = Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
            'Range("A2:" & Cells(2, UBound(strFile) + 2).Address).Select
            'MsgBox ""
            'ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.clear
            'ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A" & FinalRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            'With ActiveWorkbook.Worksheets("Sheet1").Sort
               ' .SetRange Range("A2:" & Cells(FinalRow, (UBound(strFile) + 2)).Address)
               ' .Header = xlYes
               ' .MatchCase = False
               ' .Orientation = xlTopToBottom
               ' .SortMethod = xlPinYin
               ' .Apply
            'End With
        Next j
        
    ' set status column heading
        Cells(1, (j + 1)).Value = "Status"
     
    End Sub

    I hope this makes sense and that someone can help. I may be thinking about this from the wrong perspective; so any offers of assistance will be welcome. Thanks in anticipation. 



    • Edited by toga38 Friday, August 22, 2014 10:24 AM
    Friday, August 22, 2014 10:19 AM

Answers

  • Hi Toga,

    Please try:

    Sub text1()
     ' declarations
     Dim objFSO, strFile, objTextFile
     Dim ws As Worksheet
     Dim nextRow As Integer, FinalRow As Integer ', FinalCol As Integer
     Dim IsFind As Boolean
     ' set files path
         ChDir (Application.ActiveWorkbook.Path)
     ' set objects
         Set objFSO = CreateObject("Scripting.FileSystemObject")
         Set ws = Worksheets(1)
         Cells(1, 1).Value = "Options"
     ' Set up list of file filters
         Filt = "Text Files (*.txt),*.txt"
     ' Set the dialog box caption
         Title = "Select Files to Import"
     ' Get the files
         strFile = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title, MultiSelect:=True)
     ' Exit if dialog box cancelled
         If Not IsArray(strFile) Then
             MsgBox "No files were selected."
             Exit Sub
         End If
        nextRow = 2
     ' Display full path and name of the files
         For j = LBound(strFile) To UBound(strFile)
             MsgBox "You selected " & vbCrLf & strFile(j)
             Cells(1, j + 1).Value = strFile(j)
     ' initialise row each time through loop
             Set objTextFile = objFSO.OpenTextFile(strFile(j), 1)
      ' loop through text file
             Do Until objTextFile.AtEndOfStream
                 Line = objTextFile.ReadLine()
                 myLine = Split(Line, " ")
                 If j = 1 Then
                    For i = 0 To UBound(myLine)
                        If i = 2 Then
                            If IsNumeric(Left(myLine(i), 1)) = True Then
    ' one of the files has a rough space in column 2 followed by IP address. This concaternates it before writing
                                Cells(nextRow, j + 2).Value = myLine(i - 1) & myLine(i)
                                Exit For
                            Else
    ' status value in 3rd column "value can be changed" is concaternated before writing
                                For k = 2 To UBound(myLine)
                                    Cells(nextRow, j + 2).Value = Cells(nextRow, j + 2).Value & " " & myLine(k)
                                Next k
                                Exit For
                            End If
                       Else
                           Cells(nextRow, i + 1).Value = myLine(i)
                       End If
                    Next i
                 Else
                    With Range("A:A")
                        Set c = .Find(myLine(0), LookIn:=xlValues)
                        If Not c Is Nothing Then
                            IsFind = True
                            For i = 1 To UBound(myLine)
                                If i = 2 Then
                                    If IsNumeric(Left(myLine(i), 1)) = True Then
                                        c.Offset(0, j + 1).Value = myLine(i - 1) & myLine(i)
                                        Exit For
                                    Else
                                        For k = 2 To UBound(myLine)
                                            c.Offset(0, j + 1).Value = c.Offset(0, j + 1).Value & " " & myLine(k)
                                        Next k
                                        Exit For
                                    End If
                                Else
                                    c.Offset(0, j).Value = myLine(i)
                                End If
                            Next i
                        Else
                            For i = 0 To UBound(myLine)
                                If i = 2 Then
                                    If IsNumeric(Left(myLine(i), 1)) = True Then
                                        Cells(nextRow, j + 2).Value = myLine(i - 1) & myLine(i)
                                        Exit For
                                    Else
                                        For k = 2 To UBound(myLine)
                                            Cells(nextRow, j + 2).Value = Cells(nextRow, j + 2).Value & " " & myLine(k)
                                        Next k
                                        Exit For
                                    End If
                                Else
                                    Cells(nextRow, i + 1).Value = myLine(i)
                                End If
                            Next i
                        End If
                    End With
                 End If
                 If IsFind = False Then nextRow = nextRow + 1
                 IsFind = False
             Loop
         Next j
     ' set status column heading
         Cells(1, (j + 1)).Value = "Status"
     End Sub

    My thought:

    1. For the first file, we only need to append these lines.

    2. Starting with the second file, we need to search through Range.Find Method (Excel). If current appended record is there, we could copy data in this row.

    3. For the third column, we could append every latter value.

    I have three files as below

    1.txt

    a 10
    b 5
    c 4

    2.txt

    a 11
    c 16
    e 10

    3.txt

    b 3 value can be changed
    c 0
    a 5
    d 7 value can be changed
    e 12

    The result after executing the macro:

    Regards,

    George.


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Monday, August 25, 2014 3:41 AM
    Moderator