VBA to copy only matching data from 2 csv workbooks into the "MasterCSV"

DCFreit0s

New Member
Joined
Jul 23, 2024
Messages
11
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
  2. MacOS
I have 3 sample csv files and I want to open/select 2 of the files and copy only the matching data between them into a third Master csv... I have included pictures of the 3 csv files with random data & timestamps. I am new to VBA so my code prolly isn't great but...

1. MasterCSV = the csv i want to copy the data into
2. Target_Time = the csv i want to use to match data (timestamp) against
3. Import_Data = the csv i want to copy the row data from if it matches the timestamp in Target_Time.

  1. So I want the Macro to allow me to select the Target_Time csv & Import_Data csv - these will be a new csv file for each day (24hr period)
  2. Then I want to select the rows of the Import_Data csv that have a timestamp (Column A in both csv's) matching with the timestamps of the Target_Time cvs.
  3. Finally, i want to import ONLY those rows from the Import_Data csv into the MasterCSV.
  4. I have some code already in my macro to adjust the timestamp cells into a "Date" and "Time" column so the copied rows need to start on column 3 of the MasterCSV.
  5. Finally I would like to create another macro (to use with another button) that saves the MasterCSV with the "date" of the cells in column A (which should all be the same since it's all data from a 24hr period).
PLEASE HELP!!! Ive been googling and testing different codes for days!!!

VBA Code:
Sub ImportData()
    Dim ImportFile As String
    Dim TargetFile As String
    Dim MyDateTime As Date
    Dim TargetColumn As Range
    
    TargetFile = Application.GetOpenFilename
    If TargetFile = "False" Then
        Exit Sub
    End If
    Set TargetWorkbook = Workbooks.Open(filename:=TargetFile)
    
    
    ImportFile = Application.GetOpenFilename
    If ImportFile = "False" Then
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    'Set the source and target sheets
    Set ImportWorkbook = Workbooks.Open(filename:=ImportFile)
    Set MasterSheet = ThisWorkbook.Worksheets("Data")
    Set TargetColumn = TargetWorkbook.Worksheets(1).Range("A2:A")
    
    'Find the last row in the source sheet
    lastRow = ImportWorkbook.Worksheets(1).Cells(ImportWorkbook.Worksheets(1).Rows.Count, "A").End(xlUp).Row
    'Find the last row in the Target Sheet
    TargetDTRow = TargetWorkbook.Worksheets(1).Cells(TargetWorkbook.Worksheets(1).Rows.Count, "A").End(xlUp).Row
    'Find the last row in the master sheet
    MasterLastRow = MasterSheet.Cells(MasterSheet.Rows.Count, "A").End(xlUp).Row
    
    
    'Loop through each row in the source sheet
    For i = 2 To lastRow
    'Check if cell in column A contains "Target Date/Time"
    If ImportWorkbook.Cells(i, "A").Values = TargetColumn Then
    'Copy the entire row to the target sheet
    ImportWorkbook.Rows("Bi:B").Copy Destination:=MasterSheet.Range("C, MasterLastRow")
    
    MyDateTime = ImportWorkbook.Worksheets(1).Range("A2").Value

    'get date
    ThisWorkbook.Worksheets(2).Range("A3").Value = Int(MyDateTime)
    ThisWorkbook.Worksheets(2).Range("A3").NumberFormat = "YYYY-MM-DD"

    'get time
    ThisWorkbook.Worksheets(2).Range("B3").Value = MyDateTime - Int(MyDateTime)
    ThisWorkbook.Worksheets(2).Range("B3").NumberFormat = "hh:mm:ss"
    
    ImportWorkbook.Close
    Application.ScreenUpdating = True
    End If
    Next i
End Sub
 

Attachments

  • Target_Time_CSV.png
    Target_Time_CSV.png
    33.2 KB · Views: 18
  • Import_Data_CSV.png
    Import_Data_CSV.png
    55.2 KB · Views: 18
  • MasterCSV.png
    MasterCSV.png
    48.5 KB · Views: 22

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Can we assume that the timestamps are in the same order in both files? similarly, can we assume that once a timestamp is found in 'Import_Data_CSV' further down? What I mean by this is imagine the scenario where the timestamps in 'Target_Time_CSV' are not in order. On the first run through it will find a match, but there's no guaranteeing that the second timestamp searched for is not further up in the file, which would necessitate a restart of the scan.
 
Upvote 0
Yes the timestamps in both the Import and Target csv files will always be in “ascending” order. The software they are exported from queries a database of recorded values based on time within the queried timeframe. Basically you set a timeframe (I.e. 2AM-4PM, 24hrs, 36hrs, etc) and then select the factor in which you want to query (I.e. every sec, every 10 sec, every 60 sec, etc)
 
Upvote 0
Rather than fiddle around with workbooks, would it be acceptable to deal with the CSVs directly, such that you end up with a Master CSV that just imports directly?
 
Upvote 0
Rather than fiddle around with workbooks, would it be acceptable to deal with the CSVs directly, such that you end up with a Master CSV that just imports directly?
Yes that would be great! The only caveat is the MasterCSV is actually an xslx file, I just named/labeled it wrong. The software actually exports the Import and Target data in csv files. Is it possible to still use the Master as an xslx? If not, could I either create a new MasterCSV (within the macro) to put all the data in and then just copy it (manually or in another macro) to the Master xslx file with all the cell formats and coloring in it?
 
Upvote 0
See if this works for you. Obviously could be a lot tidier, but it outputs a file called MasterYYYYMMDD.csv, which should be in a format you can read directly into your master spreadsheet. I had to jump through some hoops because my regional date format is different to yours, but I think it will be ok.

First file it prompts for is the target file, second is the import file.

VBA Code:
Sub ImportData()
    Dim Flag As Boolean
    Dim fileNumTarget As Integer, fileNumImport As Integer, fileNumMaster As Integer
    Dim ImportFile As String
    Dim TargetFile As String
    Dim txtLineImport As String, txtLineTarget As String, txtLineOutput As String
    Dim fdate As String, fday As String, fmonth As String, fyear As String, ftime As String
    TargetFile = Application.GetOpenFilename("CSV Files (*.csv), *.csv")
    ImportFile = Application.GetOpenFilename("CSV Files (*.csv), *.csv")
    fileNumTarget = FreeFile
    Open TargetFile For Input As #fileNumTarget
    fileNumImport = FreeFile
    Open ImportFile For Input As #fileNumImport
    '
    ' Throw away the first line of each file
    '
    Line Input #fileNumImport, txtLineImport
    Line Input #fileNumTarget, txtLineTarget
    While Not EOF(fileNumTarget)
        Line Input #fileNumTarget, txtLineTarget
        Do
            Line Input #fileNumImport, txtLineImport
            If Left(txtLineImport, Len(txtLineTarget)) = txtLineTarget Then
                If Not Flag Then
                    fyear = Mid(Trim(txtLineTarget), 7, 4)
                    fmonth = Left(Trim(txtLineTarget), 2)
                    fday = Mid(Trim(txtLineTarget), 4, 2)
                    fdate = fyear & fmonth & fday
                    fileNumMaster = FreeFile
                    Open "Master" & fdate & ".csv" For Output As #fileNumMaster
                    Flag = True
                End If
                fdate = fyear & "-" & fmonth & "-" & fday
                ftime = Mid(Trim(txtLineTarget), 12, 8)
                txtLineOutput = fdate & ", " & ftime & ", " & _
                        Mid(txtLineImport, InStr(1, txtLineImport, ",") + 1)
                Print #fileNumMaster, txtLineOutput
                Exit Do
            End If
        Loop
    Wend
    Close
End Sub
 
Upvote 0
So at first it threw an error at the Application.GetOpenFilename line and didnt prom for the files, so i removed the info inside the () and it prompted me to select the files. Then it threw a second error father down... I have attached screenshots.
 

Attachments

  • error 1.png
    error 1.png
    114.7 KB · Views: 18
  • error 1 debug.png
    error 1 debug.png
    120 KB · Views: 10
  • error 2.png
    error 2.png
    116.4 KB · Views: 16
  • error 2 debug.png
    error 2 debug.png
    109 KB · Views: 20
Upvote 0
Hmm - a Mac. All bets are off :)

Apparently for Application.GetOpenFilename there is an issue with the Mac implementation but unless you want to distribute this to others it's possibly not worth worrying about jumping through all the hoops for the workaround.
Regarding the second error, I assumed as shown in your initial post that each of the input files had a header row to be ignored, labelled 'timestamps' in your picture. If that is not the case comment out these two lines:
VBA Code:
    '
    ' Throw away the first line of each file
    '
    Line Input #fileNumImport, txtLineImport
    Line Input #fileNumTarget, txtLineTarget
Nevertheless the error indicates there was only one line in the file you choose as the import csv file. Can you open that file in a text editor (not in Excel) and post a picture.
Here is a picture of the version I used as a test.
1721887041566.png
 
Upvote 0
Hmm - a Mac. All bets are off :)

Apparently for Application.GetOpenFilename there is an issue with the Mac implementation but unless you want to distribute this to others it's possibly not worth worrying about jumping through all the hoops for the workaround.
Regarding the second error, I assumed as shown in your initial post that each of the input files had a header row to be ignored, labelled 'timestamps' in your picture. If that is not the case comment out these two lines:
VBA Code:
    '
    ' Throw away the first line of each file
    '
    Line Input #fileNumImport, txtLineImport
    Line Input #fileNumTarget, txtLineTarget
Nevertheless the error indicates there was only one line in the file you choose as the import csv file. Can you open that file in a text editor (not in Excel) and post a picture.
Here is a picture of the version I used as a test.
View attachment 114469
Yes i can confirm that the Import_Data csv has a header line.
 

Attachments

  • Import_Data_csv_TextEdit.png
    Import_Data_csv_TextEdit.png
    42 KB · Views: 14
Upvote 0
Well it's a bit of a mystery but try this updated code.

VBA Code:
Sub ImportData()
    Dim Flag As Boolean
    Dim fileNumTarget As Integer, fileNumImport As Integer, fileNumMaster As Integer
    Dim ImportFile As String
    Dim TargetFile As String
    Dim txtLineImport As String, txtLineTarget As String, txtLineOutput As String
    Dim fdate As String, fday As String, fmonth As String, fyear As String, ftime As String
    TargetFile = Application.GetOpenFilename(, , "Target file")
    ImportFile = Application.GetOpenFilename(, , "Import file")
    fileNumTarget = FreeFile
    Open TargetFile For Input As #fileNumTarget
    fileNumImport = FreeFile
    '
    ' Throw away the first line of each file
    '
    Line Input #fileNumTarget, txtLineTarget
    While Not EOF(fileNumTarget)
        Line Input #fileNumTarget, txtLineTarget
        Open ImportFile For Input As #fileNumImport
    Line Input #fileNumImport, txtLineImport
        While Not EOF(fileNumImport)
            Line Input #fileNumImport, txtLineImport
            If Left(txtLineImport, Len(txtLineTarget)) = txtLineTarget Then
                If Not Flag Then
                    fyear = Mid(Trim(txtLineTarget), 7, 4)
                    fmonth = Left(Trim(txtLineTarget), 2)
                    fday = Mid(Trim(txtLineTarget), 4, 2)
                    fdate = fyear & fmonth & fday
                    fileNumMaster = FreeFile
                    Open "Master" & fdate & ".csv" For Output As #fileNumMaster
                    Flag = True
                End If
                fdate = fyear & "-" & fmonth & "-" & fday
                ftime = Mid(Trim(txtLineTarget), 12, 8)
                txtLineOutput = fdate & ", " & ftime & ", " & _
                        Mid(txtLineImport, InStr(1, txtLineImport, ",") + 1)
                Print #fileNumMaster, txtLineOutput
            End If
        Wend
        Close #fileNumImport
    Wend
    Close
End Sub
 
Upvote 0

Forum statistics

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

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