Importing csv data from multiple source files into a master workbook into resp sheets

[dubdurd]

Hi friends!

Newbie here, trying hard since days to find/learn what im looking for, with no success. You are my last hope. Probably not that hard to solve for some of you. I hope.

So, I have a master worksheet with several sheets (ie sheet1, sheet2, sheet3, etc). Daily we get source files (csv, sourcefile1_date, sourcefile2_date, etc) via email, which I download, open in text editor, copy manually and paste manually into the resp. sheets in the master workbook in the first empty cell in the list of each sheet.

My question: How can I manage with VBA, with a button on the first sheet (instructions sheet) to import the data from the csv files into their resp. sheet.

Meaning, when i have the sourcefile "sourcefile1_date", how can I tell excel to look for the name of that sourcefile, compare that name with the name of sheet1, sheet2, etc, until it matches the name from the sourcefile1_date and paste it in there in the first empty cell underneath the existing list. And do that for all selected files, putting their data into the correct sheets. The names of the sourcefiles and the sheets are the same, so excel basically just needs to compare the names to find the correct sheet for the sourcefile.

I have managed to import the main csv file into the first instructions sheet (i will post the code below), but telling excel via VBA to search for the name of the rest of the csv files, by comparing their names to the names of the sheets (sheet1, sheet2, sheet3, etc.) in order to insert it there into the first empty cell...please help!

Thanks a mill upfront, dear community



Sub ImportReport()


Dim fileToOpen As Variant
Dim fileFilterPattern As String


ChDrive "C:"
ChDir "C:\User\testfiles\"


Application.ScreenUpdating = False


fileToOpen = Application.GetOpenFilename()


If fileToOpen = False Then
'Input cancelled
MsgBox "No file selected"


Else
Workbooks.OpenText _
fileName:=fileToOpen, _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True, _
Semicolon:=True, _
Comma:=False, _
Space:=False, _
Other:=False, _
FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), _
TrailingMinusNumbers:=True
Columns("A:A").EntireColumn.AutoFit
Range("A1:B50").Select
Selection.Copy


Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = True

'Find first empty cell in column C
Dim FirstCell As String
Dim i As Integer
FirstCell = "C4"
Range(FirstCell).Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = "" Then
Exit Do
Else
ActiveCell.Offset(1, 0).Select
End If
Loop


ActiveSheet.Paste

'Jump to the first empty cell in column C again
FirstCell = "C4"
Range(FirstCell).Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = "" Then
Exit Do
Else
ActiveCell.Offset(1, 0).Select
End If
Loop


End If


Application.ScreenUpdating = True


End Sub

[snb]

Create a querytable in each worksheet, linkedto the respective csv-files,
When opening the file all links will be updated.
Copy the new data to a separate integration worksheet. There will reside the databse with all dtat.

[Kenneth Hobs]

Sub Main() Dim p As String, fe As String, fileToOpen As String, i As Integer
Dim twb As Workbook, ws As Worksheet, ws1 As Worksheet, r As Range

p = "C:\User\testfiles\"
fe = ".txt"

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

Set twb = ThisWorkbook
'Set ws1 = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

For i = 2 To twb.Worksheets.Count 'WorkSheet(1)=Welcome sheet, so skip.
Set ws = twb.Worksheets(i)
fileToOpen = p & ws.Name & fe
If Dir(fileToOpen) = ws.Name & fe Then
Workbooks.OpenText _
Filename:=fileToOpen, _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True, _
Semicolon:=True, _
Comma:=False, _
Space:=False, _
Other:=False, _
FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), _
TrailingMinusNumbers:=True

ActiveSheet.UsedRange.Copy
Set r = ws.Cells(Rows.Count, "C").End(xlUp).Offset(1)
If r.Row < 4 Then Set r = ws.Range("C4")
r.PasteSpecial xlPasteValues

ActiveWorkbook.Close False
End If
Next i

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub

[dubdurd]

Create a querytable in each worksheet, linkedto the respective csv-files,
When opening the file all links will be updated.
Copy the new data to a separate integration worksheet. There will reside the databse with all dtat.

Hey, thanks for your answer. Ill have to dive into queries first, that'd take too much time for now, I have to find a solution without queries for now. Thats why I had to implement

For Each qr In ThisWorkbook.Queries
qr.Delete
Next qr

in the end of my code. Which is still not really working.

[dubdurd]

Thanks ! But your code isnt doing anything. Like literally nothing. I have changed the path of course but nothing is happening... Im trying to record a macro but even that is complicated. If you have an idea, id appreciate that. Thanks again

[dubdurd]

Im really considering jumping out the window. Why is it so hard to copy a defined range from one csv-file into another workbook into a sheet which has similarities in the name as the source-csv-file. Searching for the first empty cell and just pasting it. This is driving me nuts. I already tried at least 8 different approaches, recorded macros, etc.

[Kenneth Hobs]

In post #5, are you talking about my code? I most always test code before posting solutions so I know that it "works".

Obviously, Dim line starts on line 2. When posting code to the forum, it often skips the first crlf.

When you say changed path, did it include the trailing backslash character? Did you also change the file extension if not .txt? Another reason for not working may be sheet protection?

Of course your base file name like ken.txt would need a matching sheet name of ken in one of sheets 2 to the last one.

Did you paste the code in a Module? Always Debug > Compile before doing a test run. That would catch the 2 lines on 1 line error I explained earlier. It is just a good practice anyway.

If still an issue, please post the code that you used. Or attach a simple obfuscated file.

[snb]

Why don't you post a sample Excel file and 2 .txt files ?

[Kenneth Hobs]

Obviously, sample test files help us help you better.

In the attachment I changed the path to the 2 included super simple txt files to the stored workbook's path. Otherwise, Main() is the same.

[dubdurd]

kenneth hobs, sorry, forgot to mention you. Thank you for your patience. Ye, when I execute the module with your code nothing happens. When I debug, it goes through the code without issues, it seems. But no result either. Maybe I wasnt explaining my issue not clear enough. Apologies. Yes, backlash, changed fe to .csv, no sheet protection.

The sheets in the master workbook are just partwise the name of the sourcefiles. For example: Sourcefile_ServiceABC_20210211. csv (or Sourcefile_ServiceDEF_20210211. csv) must be pasted into the sheet ServiceABC (resp into sheet ServiceDEF) in the workbook in the first empty cell in column C (in all sheets the same). But it happens that I receive two or three sourcefiles for every sheet, just with a different date in the sourcefile name (ie Sourcefile_ServiceABC_20210211. csv, Sourcefile_ServiceABC_20210212. csv, Sourcefile_ServiceABC_20210213. csv).

So, the code should check first for the name of the sourcefile (Sourcefile_ServiceABC_20210211.csv, or Sourcefile_ServiceDEF_20210211.csv, etc.) and then find the right sheet and import it into the correct cell.

For some reason, no matter what way I try to realise that another issue, error message pops up.

Kenneth Hobs & snb: I dont think I can post the original files since it is company related internal data, apologies. I was able to realise it for the "overall report" which is imported into the "introduction sheet" where the buttons are located for the code, but as soon it comes to several sheets, several sourcefiles, always a new issue pops up. The newest one was "runtime error 1004 the worksheet data for a table needs to be on the same sheet as the table" after recording a lengthy macro where I did everything manually. I dont understand this error message, either.

Going to try your .zip now Kenneth Hobs

Thanks a mill guys!!

[Kenneth Hobs]

Obviously, "nothing happens" using my code in #3 because no base filenames, less the file extension, matched a sheet's name.

When seeking help and your data is sensitive, obfuscate it and attach that. Or, just make simple files with a small dataset that shows your format.

From your first post, those are not csv files since they are double quote delimited and semi-colon separated as defined in your Workbooks.OpenText options in #1. CSV files are comma separated value file type. If they were true CSV file types, other methods besides OpenText could be used.

You can use Filter() like this below to get the partial matches. If you rename the file extensions to txt, then this macro would import the data as one expects. It still does but it is all in one column for the psuedo csv files if you rename the txt files that I posted to be csv.

As usual, test on backup copy of master file.


Sub Main()
Dim p As String, fe As String, fileToOpen As String, i As Integer, j As Integer
Dim twb As Workbook, ws As Worksheet, ws1 As Worksheet, r As Range
Dim a, b, f

'p = "C:\User\testfiles\"
p = ThisWorkbook.Path & "\"
fe = ".csv"

'Put all base filenames with file extension fe in folder p into array a.
a = Split(CreateObject("Wscript.Shell").Exec("cmd /c dir " & """" & p & "*" & fe & """" & " /b").StdOut.ReadAll, vbCrLf)
If UBound(a) < 0 Then Exit Sub

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

Set twb = ThisWorkbook

For i = 2 To twb.Worksheets.Count 'WorkSheet(1)=Welcome sheet, so skip.
Set ws = twb.Worksheets(i)
b = Filter(a, "_" & ws.Name & "_", True, vbTextCompare)
If UBound(b) < 0 Then GoTo Nexti
For j = 0 To UBound(b)
Workbooks.OpenText _
Filename:=b(j), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True, _
Semicolon:=True, _
Comma:=False, _
Space:=False, _
Other:=False, _
FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), _
TrailingMinusNumbers:=True

ActiveSheet.UsedRange.Copy
Set r = ws.Cells(Rows.Count, "C").End(xlUp).Offset(1)
If r.Row < 4 Then Set r = ws.Range("C4")
r.PasteSpecial xlPasteValues

ActiveWorkbook.Close False
Next j
Nexti:
Next i

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub

[snb]

I dont think I can post the original files since it is company related internal data, apologies.

Don't be daft. We don't ask for this. You only have to replace meaningful by dummy data.