VBA - Append CSV data to current file

F

Flyuphigh

New Member
Joined
Jul 12, 2024
Messages
7
Office Version
  1. 2003 or older
Platform
  1. Windows
Thank you all in advance. I have a daily data import (DailyData.csv) drop into my downloads file that needs to append all new data into another csv data file (SourceData.csv) that feeds a power pivot table in another excel file. I managed to utilize the following VBA code (Append_Headers) to create and import the first data set with headers. VBA2 (Append_NoHeaders) appends subsequent data. Unfortunately VBA2 fails with high volume of rows. I use csv file as each data drop is approximately 500K rows. I need the following help:

1. Revise VBA1 if there is an easier way more efficient way
2. VBA code 2 to -append- subsequent imports which are dropped automatically with the same file name and next version number i.e. ReportData(1), ReportData(2) etc.
3. Appended rows must exclude any empty rows or headers.

Ideally, it would be great to have one VBA code in the same file where the data is appended from the daily drop file. Thank you again for any help.
 

Attachments

  • Screenshot Macro 1 and 2.png
    Screenshot Macro 1 and 2.png
    138.3 KB · Views: 39

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Sort by date Sort by votes
Upvote 0
Flyuphigh said:
Thank you all in advance. I have a daily data import (DailyData.csv) drop into my downloads file that needs to append all new data into another csv data file (SourceData.csv) that feeds a power pivot table in another excel file. I managed to utilize the following VBA code (Append_Headers) to create and import the first data set with headers. VBA2 (Append_NoHeaders) appends subsequent data. Unfortunately VBA2 fails with high volume of rows. I use csv file as each data drop is approximately 500K rows. I need the following help:

1. Revise VBA1 if there is an easier way more efficient way
2. VBA code 2 to -append- subsequent imports which are dropped automatically with the same file name and next version number i.e. ReportData(1), ReportData(2) etc.
3. Appended rows must exclude any empty rows or headers.

Ideally, it would be great to have one VBA code in the same file where the data is appended from the daily drop file. Thank you again for any help.
Click to expand...
Flyuphigh said:
Thank you all in advance. I have a daily data import (DailyData.csv) drop into my downloads file that needs to append all new data into another csv data file (SourceData.csv) that feeds a power pivot table in another excel file. I managed to utilize the following VBA code (Append_Headers) to create and import the first data set with headers. VBA2 (Append_NoHeaders) appends subsequent data. Unfortunately VBA2 fails with high volume of rows. I use csv file as each data drop is approximately 500K rows. I need the following help:

1. Revise VBA1 if there is an easier way more efficient way
2. VBA code 2 to -append- subsequent imports which are dropped automatically with the same file name and next version number i.e. ReportData(1), ReportData(2) etc.
3. Appended rows must exclude any empty rows or headers.

Ideally, it would be great to have one VBA code in the same file where the data is appended from the daily drop file. Thank you again for any help.
Click to expand...
VBA Code: 
Sub Append_Headers()
 
    Dim sourceFile As String
    Dim destFile As String
    Dim inputLine As String
    Dim fileNum1 As Long
    Dim fileNum2 As Long
    Dim lineCount As Long
    
    sourceFile = "C:\Users\willa\Downloads\DailyData.csv"
    destFile = "C:\Users\willa\Downloads\SourceData.csv"
    
    fileNum1 = FreeFile()
    Open sourceFile For Input As #fileNum1
    
    fileNum2 = FreeFile()
    Open destFile For Append As #fileNum2
    
        lineCount = 0
        Do Until EOF(fileNum1)
            Line Input #fileNum1, inputLine
            lineCount = lineCount + 1
            Print #fileNum2, inputLine
            
        Loop
        
    Close #fileNum1
    Close #fileNum2
    
End Sub
Sub Append_Noheaders()
 
    Dim sourceFile As String
    Dim destFile As String
    Dim inputLine As String
    Dim fileNum1 As Long
    Dim fileNum2 As Long
    Dim lineCount As Long
    
    sourceFile = "C:\Users\willa\Downloads\DailyData.csv"
    destFile = "C:\Users\willa\Downloads\SourceData.csv"
    
    fileNum1 = FreeFile()
    Open sourceFile For Input As #fileNum1
    
    fileNum2 = FreeFile()
    Open destFile For Append As #fileNum2
    
        lineCount = 0
        Do Until EOF(fileNum1)
            Line Input #fileNum1, inputLine
            lineCount = lineCount + 1
            If lineCount > 1 Then 'skip the first 1 rows
                Print #fileNum2, inputLine
            End If
            
        Loop
        
    Close #fileNum1
    Close #fileNum2
    
End Sub
 
Upvote 0
I have amended your macro so that instead of reading the source file line by line, it reads the entire file, and assigns its contents to a variable. From there, it splits the contents into lines of text, and assigns it to an array. Then it transfers all rows, except the header row, to another array. And, lastly, it appends the entire contents to the destination file.

Does this help?

VBA Code: 
Sub Append_Noheaders()
 
    Dim sourceFile As String
    Dim destFile As String
    Dim fileContents As String
    Dim linesOfText() As String
    Dim linesOfTextNoHeader() As String
    Dim fileContentsNoHeader As String
    Dim fileNum1 As Long
    Dim fileNum2 As Long
    Dim numOfLines As Long
    Dim lineCount As Long
    Dim i As Long
   
    sourceFile = "C:\Users\willa\Downloads\DailyData.csv"
    destFile = "C:\Users\willa\Downloads\SourceData.csv"
   
    fileNum1 = FreeFile()
    Open sourceFile For Input As #fileNum1
        fileContents = Input(LOF(fileNum1), #fileNum1)
    Close #fileNum1
   
    linesOfText() = Split(fileContents, vbCrLf) 'or vbLf
   
    numOfLines = UBound(linesOfText) + 1
   
    If numOfLines > 1 Then
   
        ReDim linesOfTextNoHeader(0 To UBound(linesOfText) - 1)
       
        i = 0
        For lineCount = 1 To UBound(linesOfText)
            linesOfTextNoHeader(i) = linesOfText(lineCount)
            i = i + 1
        Next lineCount
       
        fileContentsNoHeader = VBA.Join(linesOfTextNoHeader, vbCrLf) 'or vbLf
       
        fileNum2 = FreeFile()
        Open destFile For Append As #fileNum2
            Print #fileNum2, fileContentsNoHeader
        Close #fileNum2
       
    End If
   
End Sub
 
Upvote 0
This one keeps your same basic approach, but merges your two subs into one. @Domenic's might be speedier because of it's array-based approach.

VBA Code: 
Sub Append_CSV_Data()
 
    Dim sourceFile As String
    Dim destFile As String
    Dim inputLine As String
    Dim fileNum1 As Integer
    Dim fileNum2 As Integer
    Dim lineCount As Long
    Dim StartLine As Long

    sourceFile = "C:\Users\willa\Downloads\DailyData.csv"
    destFile = "C:\Users\willa\Downloads\SourceData.csv"

    With CreateObject("Scripting.FileSystemObject")
        If Not .FileExists(sourceFile) Then
            MsgBox "Source File '" & sourceFile & "' does not exist"
            Exit Sub
        Else
            fileNum1 = FreeFile
            Open sourceFile For Input As #fileNum1
        End If
     
        fileNum2 = FreeFile
        If Not .FileExists(destFile) Then
            Open destFile For Output Access Write As #fileNum2
            StartLine = 0
        Else
            Open destFile For Append As #fileNum2
            StartLine = 1
        End If
    End With
 
    lineCount = 0
    Do Until EOF(fileNum1)
        Line Input #fileNum1, inputLine
        lineCount = lineCount + 1
        If lineCount > StartLine Then
            Print #fileNum2, inputLine
        End If
        If lineCount Mod 1000 = 0 Then
            Application.StatusBar = "Lines scanned: " & lineCount
        End If
    Loop
    Application.StatusBar = ""
    Close #fileNum1
    Close #fileNum2
End Sub
 
Last edited:
Upvote 0
rlv01 said:
This one keeps your same basic approach, but merges your two subs into one. @Domenic's might be speedier because of it's array-based approach.

VBA Code: 
Sub Append_CSV_Data()
 
    Dim sourceFile As String
    Dim destFile As String
    Dim inputLine As String
    Dim fileNum1 As Integer
    Dim fileNum2 As Integer
    Dim lineCount As Long
    Dim StartLine As Long

    sourceFile = "C:\Users\willa\Downloads\DailyData.csv"
    destFile = "C:\Users\willa\Downloads\SourceData.csv"

    With CreateObject("Scripting.FileSystemObject")
        If Not .FileExists(sourceFile) Then
            MsgBox "Source File '" & sourceFile & "' does not exist"
            Exit Sub
        Else
            fileNum1 = FreeFile
            Open sourceFile For Input As #fileNum1
        End If
    
        fileNum2 = FreeFile
        If Not .FileExists(destFile) Then
            Open destFile For Output Access Write As #fileNum2
            StartLine = 0
        Else
            Open destFile For Append As #fileNum2
            StartLine = 1
        End If
    End With
 
    lineCount = 0
    Do Until EOF(fileNum1)
        Line Input #fileNum1, inputLine
        lineCount = lineCount + 1
        If lineCount > StartLine Then
            Print #fileNum2, inputLine
        End If
        If lineCount Mod 1000 = 0 Then
            Application.StatusBar = "Lines scanned: " & lineCount
        End If
    Loop
    Application.StatusBar = ""
    Close #fileNum1
    Close #fileNum2
End Sub
Click to expand...
Thank you very much. This is a tad slower when the file is larger but it works great as the first VBA (headers included) that can be followed by appending without headers.
 
Upvote 0
Domenic said:
I have amended your macro so that instead of reading the source file line by line, it reads the entire file, and assigns its contents to a variable. From there, it splits the contents into lines of text, and assigns it to an array. Then it transfers all rows, except the header row, to another array. And, lastly, it appends the entire contents to the destination file.

Does this help?

VBA Code: 
Sub Append_Noheaders()
 
    Dim sourceFile As String
    Dim destFile As String
    Dim fileContents As String
    Dim linesOfText() As String
    Dim linesOfTextNoHeader() As String
    Dim fileContentsNoHeader As String
    Dim fileNum1 As Long
    Dim fileNum2 As Long
    Dim numOfLines As Long
    Dim lineCount As Long
    Dim i As Long
  
    sourceFile = "C:\Users\willa\Downloads\DailyData.csv"
    destFile = "C:\Users\willa\Downloads\SourceData.csv"
  
    fileNum1 = FreeFile()
    Open sourceFile For Input As #fileNum1
        fileContents = Input(LOF(fileNum1), #fileNum1)
    Close #fileNum1
  
    linesOfText() = Split(fileContents, vbCrLf) 'or vbLf
  
    numOfLines = UBound(linesOfText) + 1
  
    If numOfLines > 1 Then
  
        ReDim linesOfTextNoHeader(0 To UBound(linesOfText) - 1)
      
        i = 0
        For lineCount = 1 To UBound(linesOfText)
            linesOfTextNoHeader(i) = linesOfText(lineCount)
            i = i + 1
        Next lineCount
      
        fileContentsNoHeader = VBA.Join(linesOfTextNoHeader, vbCrLf) 'or vbLf
      
        fileNum2 = FreeFile()
        Open destFile For Append As #fileNum2
            Print #fileNum2, fileContentsNoHeader
        Close #fileNum2
      
    End If
  
End Sub
Click to expand...
Thank you Domenic! This works great and it's quick. As written, any subsequent appendage is currently separated by an empty row. To make the append complete is it possible to append without the empty row at the end?
 
Upvote 0
It looks like your source files contain an empty row at the end of them, hence those blank rows in your destination file. So I've amended the macro so that after reading the entire contents of the file and assigning it to a variable, it checks whether there's a carriage return at the end of it. If so, it removes it, before it proceeds with splitting into an array, etc.

VBA Code: 
Sub Append_Noheaders()
 
    Dim sourceFile As String
    Dim destFile As String
    Dim fileContents As String
    Dim linesOfText() As String
    Dim linesOfTextNoHeader() As String
    Dim fileContentsNoHeader As String
    Dim fileNum1 As Long
    Dim fileNum2 As Long
    Dim numOfLines As Long
    Dim lineCount As Long
    Dim i As Long
  
    Const DELIM As String = vbCrLf
 
    
    sourceFile = "C:\Users\willa\Downloads\DailyData.csv"
    destFile = "C:\Users\willa\Downloads\SourceData.csv"
 
    fileNum1 = FreeFile()
    Open sourceFile For Input As #fileNum1
        fileContents = Input(LOF(fileNum1), #fileNum1)
    Close #fileNum1
  
    If (Right$(fileContents, 2) = DELIM) Then
        fileContents = Left$(fileContents, Len(fileContents) - Len(DELIM))
    End If
 
    linesOfText() = Split(fileContents, DELIM)
 
    numOfLines = UBound(linesOfText) + 1
 
    If numOfLines > 1 Then
 
        ReDim linesOfTextNoHeader(0 To UBound(linesOfText) - 1)
    
        i = 0
        For lineCount = 1 To UBound(linesOfText)
            linesOfTextNoHeader(i) = linesOfText(lineCount)
            i = i + 1
        Next lineCount
    
        fileContentsNoHeader = VBA.Join(linesOfTextNoHeader, vbCrLf)
    
        fileNum2 = FreeFile()
        Open destFile For Append As #fileNum2
            Print #fileNum2, fileContentsNoHeader
        Close #fileNum2
    
    End If
 
End Sub

Hope this helps!
 
Upvote 0
Domenic said:
It looks like your source files contain an empty row at the end of them, hence those blank rows in your destination file. So I've amended the macro so that after reading the entire contents of the file and assigning it to a variable, it checks whether there's a carriage return at the end of it. If so, it removes it, before it proceeds with splitting into an array, etc.

VBA Code: 
Sub Append_Noheaders()
 
    Dim sourceFile As String
    Dim destFile As String
    Dim fileContents As String
    Dim linesOfText() As String
    Dim linesOfTextNoHeader() As String
    Dim fileContentsNoHeader As String
    Dim fileNum1 As Long
    Dim fileNum2 As Long
    Dim numOfLines As Long
    Dim lineCount As Long
    Dim i As Long
 
    Const DELIM As String = vbCrLf
 
  
    sourceFile = "C:\Users\willa\Downloads\DailyData.csv"
    destFile = "C:\Users\willa\Downloads\SourceData.csv"
 
    fileNum1 = FreeFile()
    Open sourceFile For Input As #fileNum1
        fileContents = Input(LOF(fileNum1), #fileNum1)
    Close #fileNum1
 
    If (Right$(fileContents, 2) = DELIM) Then
        fileContents = Left$(fileContents, Len(fileContents) - Len(DELIM))
    End If
 
    linesOfText() = Split(fileContents, DELIM)
 
    numOfLines = UBound(linesOfText) + 1
 
    If numOfLines > 1 Then
 
        ReDim linesOfTextNoHeader(0 To UBound(linesOfText) - 1)
  
        i = 0
        For lineCount = 1 To UBound(linesOfText)
            linesOfTextNoHeader(i) = linesOfText(lineCount)
            i = i + 1
        Next lineCount
  
        fileContentsNoHeader = VBA.Join(linesOfTextNoHeader, vbCrLf)
  
        fileNum2 = FreeFile()
        Open destFile For Append As #fileNum2
            Print #fileNum2, fileContentsNoHeader
        Close #fileNum2
  
    End If
 
End Sub

Hope this helps!
Click to expand...
I tried it but the empty row at the end of each append still appears.Screenshot 2024-08-05 154748.png
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Import csv file and append to existing table?
Replies
5
Views
1K
shellp
S
T
  • Solved
Import Data Starting from next empty row
Replies
7
Views
385
Tanne
T
A
  • Question
Need to repeat the first row in every csv file created
Replies
1
Views
304
rpaulson
rpaulson
D
  • Locked
  • Question
VBA to copy only matching data from 2 csv workbooks into the "Master Workbook"
Replies
1
Views
223
RoryA
RoryA
D
  • Solved
VBA to copy only matching data from 2 csv workbooks into the "MasterCSV"
2
Replies
18
Views
723
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,220,965
Messages
6,157,119
Members
451,398
Latest member
rjsteward

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top