CODEWITHSUNDEEP
excelvbaappend
Beans
Beans

Reputation: 139

Appending data from .txt to an excel sheet

I have two .txt files. They have exactly same format and columns.

The first .txt file looks like this:

enter image description here

And this is the VBA code I am using to export the data from the first .txt file to an excel sheet (shared by @FaneDuru)

Sub CopyLessColumns()
 Dim strSpec As String, i As Long, colToRet As Long
 Dim arrSp As Variant, arrRez() As String, arrInt As Variant, j As Long
 Dim fso As Object, txtStr As Object, strText As String

  Set fso = CreateObject("Scripting.FileSystemObject")
  strSpec = "C:\Users\xxxxxxxxx\Desktop\Input.txt"
  If Dir(strSpec) <> "" Then                   
    Set txtStr = fso.OpenTextFile(strSpec)
        strText = txtStr.ReadAll
    txtStr.Close
 End If

  arrSp = Split(strText, vbCrLf)
  colToRet = 5                             'Number of columns you need
  ReDim arrRez(UBound(arrSp), colToRet - 1)
  For i = 0 To UBound(arrSp)
    arrInt = Split(arrSp(i), vbTab)
    If UBound(arrInt) > colToRet - 1 Then
        For j = 0 To colToRet - 1
            arrRez(i, j) = arrInt(j)
        Next j
    End If
  Next i
  ActiveSheet.Range(Cells(1, 1), Cells(UBound(arrRez, 1) + 1, UBound(arrRez, 2) + 1)).Value = arrRez
End Sub

After I run the code above, my excel sheet will look like this:

enter image description here

But I am not sure how to append data from the second .txt file to my existing spreadsheet.

Below is my second .txt file. Same format, same column numbers, just different data.

enter image description here

I want to append data from the second .txt file to my spreadsheet, so it can look like this

enter image description here

As you can see, when I import the second .txt file, I want to skip the header row, and directly import the data below the first row.

In addition, the row number of the first .txt file can change any time, so I cannot just use the exact same code and simply change the last line from 

ActiveSheet.Range(Cells(2, 1), Cells(UBound(arrRez, 1) + 1, UBound(arrRez, 2) + 1)).Value = arrRez

to

ActiveSheet.Range(Cells(4, 1), Cells(UBound(arrRez, 1) + 1, UBound(arrRez, 2) + 1)).Value = arrRez

I also tried to find the last row by using 

lRow = Cells(Rows.Count, 1).End(xlUp).Row

Then, change the last line to 

ActiveSheet.Range(Cells(lRow, 1), Cells(UBound(arrRez, 1) + 1, UBound(arrRez, 2) + 1)).Value = arrRez

But that didn't work either. It will just overwrite the last row of the existing data on the spreadsheet with the header row in the second .txt file

I tried to look up online, but didn’t find anything similar to what I am trying to do here, So, any comments would be appreciated!

Upvotes: 0

Views: 801

Answers (1)

FaneDuru
FaneDuru

Reputation: 42256

Please use this code version! It is the same for as many text files you want to load. It will load the table headers only ones (When the sheet is empty) and then only data, without headers:

Private Sub CopyLessColumns() 'it copies less columns than the txt file has
 Dim strSpec As String, i As Long, colToRet As Long, lastR As Long
 Dim arrSp As Variant, arrRez() As String, arrInt As Variant, j As Long, k As Long
 Dim fso As Object, txtStr As Object, strText As String 'no need of any reference

  Set fso = CreateObject("Scripting.FileSystemObject")
  strSpec = "C:\Teste VBA Excel\TextFileTabDel.txt"
  If Dir(strSpec) <> "" Then 'check if file exists
    Set txtStr = fso.OpenTextFile(strSpec)
        strText = txtStr.ReadAll
    txtStr.Close
  End If
  arrSp = Split(strText, vbCrLf)

    colToRet = 5 'Number of columns to be returned
    lastR = ActiveSheet.Range("A" & Rows.count).End(xlUp).Row 'last row in A:A
    'arrRez is dimensioned from 0 to UBound(arrSp) only for lastR = 1
    ReDim arrRez(IIf(lastR = 1, 0, 1) To UBound(arrSp), colToRet - 1)
    For i = IIf(lastR = 1, 0, 1) To UBound(arrSp) 'Only in case of larR = 1, the
                                                  'head of the table is load in arr
      arrInt = Split(arrSp(i), vbTab)  'each strText line is split in an array
      If UBound(arrInt) > colToRet - 1 Then
          For j = 0 To colToRet - 1
              arrRez(i, j) = arrInt(j) 'each array element is loaded in the arrRez
          Next j
      End If
    Next i
    'The array is dropped in the dedicated range (calculated using Resize):
    ActiveSheet.Range("A" & IIf(lastR = 1, lastR, lastR + 1)).Resize(UBound(arrRez, 1), _
                                                UBound(arrRez, 2) + 1).Value = arrRez
End Sub

Upvotes: 1

Related Questions