• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Importing Multiple Text Files in a worksheet

Dear All,
Greetings of the day!

I have a requirement of importing multiple text files into a worksheet named "Data" in same workbook. Although, the below pasted helps up to some extent, but there is two problems.

First, it imports data in a new workbook, instead in same workbook.
Second, it fetches duplicate header name.

Moreover, I have already placed Header Name in Worksheet Named- "Data", I just want data of all .txt files to be placed just beneath of Header Name without any duplicate Header Name.

PS:- Please see the attached excel file for the further investigation.

Code:
Option Explicit

Sub MergeAllWorkbooks()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long, FNum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim sourceRange As Range, destrange As Range
Dim rnum As Long, CalcMode As Long
Dim LastRow As Long, LastCol As Long

' To adding multiple CSV into one. Need to remove duplicate HeaderRow in this.

' Change this to the path\folder location of your files.
MyPath = InputBox("Enter the address here")

' Add a slash at the end of the path if needed.
If Right(MyPath, 1) <> "\" Then
    MyPath = MyPath & "\"
End If

' If there are no Excel files in the folder, exit.
FilesInPath = Dir(MyPath & "*.txt*") 'You can change the file type to suit your need here
If FilesInPath = "" Then
    MsgBox "No files found"
    Exit Sub
End If

' Fill the myFiles array with the list of Excel files
' in the search folder.
FNum = 0
Do While FilesInPath <> ""
    FNum = FNum + 1
    ReDim Preserve MyFiles(1 To FNum)
    MyFiles(FNum) = FilesInPath
    FilesInPath = Dir()
Loop

' Set various application properties.
With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
End With

' Add a new workbook with one sheet.
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
rnum = 1

' Loop through all files in the myFiles array.
If FNum > 0 Then
    For FNum = LBound(MyFiles) To UBound(MyFiles)
        Set mybook = Nothing
        On Error Resume Next
        Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))
        On Error GoTo 0

        If Not mybook Is Nothing Then
            On Error Resume Next

            ' Change this range to fit your own needs.
            With mybook.Worksheets(1)
                LastRow = .Cells(Rows.Count, 1).End(xlUp).Row 'choose which column has data all the way down the last row
                LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column

                Set sourceRange = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))

            End With

            If Err.Number > 0 Then
                Err.Clear
                Set sourceRange = Nothing
            Else
                ' If source range uses all columns then
                ' skip this file.
                If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
                    Set sourceRange = Nothing
                End If
            End If
            On Error GoTo 0

            If Not sourceRange Is Nothing Then

                SourceRcount = sourceRange.Rows.Count

                If rnum + SourceRcount >= BaseWks.Rows.Count Then
                    MsgBox "There are not enough rows in the target worksheet."
                    BaseWks.Columns.AutoFit
                    mybook.Close SaveChanges:=False
                    GoTo ExitTheSub
                Else

                    ' Copy the file name in column A, if you want; Here I choose not.
                    ' With sourceRange
                        ' BaseWks.Cells(rnum, "A"). _
                                ' Resize(.Rows.Count).Value = MyFiles(FNum)
                    ' End With

                    ' Set the destination range.
                    Set destrange = BaseWks.Range("A" & rnum)

                    ' Copy the values from the source range
                    ' to the destination range.
                    With sourceRange
                        Set destrange = destrange. _
                                        Resize(.Rows.Count, .Columns.Count)
                    End With
                    destrange.Value = sourceRange.Value

                    rnum = rnum + SourceRcount
                End If
            End If
            mybook.Close SaveChanges:=False
        End If

    Next FNum
    BaseWks.Columns.AutoFit
End If

ExitTheSub:
' Restore the application properties.
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = CalcMode
End With
End Sub

Regards,
Ravindra Bisht
 
Last edited by a moderator:
Hi,​
attach at least a couple of source text files and the exact expected result workbook according to these source files.​
Or use the text import Excel feature from the Data menu and just well answer to its assistant …​
It should need less than 30 codelines.​
 
Dear Sir,
No, there will be just sheet1 in across all workbook. I will upload .txt files having data shortly. Well, I don't have idea about power query.
Regards,
Ravindra
 
rkbisht2019
Did You just skip #2 reply?
as well as
Your PS:- Please see the attached excel file for the further investigation.
There is none file.
Dear All,

Please find attached files for reference.
 

Attachments

  • File-1.txt
    528 bytes · Views: 4
  • File-2.txt
    1.3 KB · Views: 2
  • File-3.txt
    355 bytes · Views: 2
  • iAutoNew.xlsm
    27.9 KB · Views: 1
Hi,​
first edit your post and use the Code option in the 3 dots icon in order to 'delimiter' your VBA procedure.​
Once done, attach at least a couple of source text files and the exact expected result workbook according to these source files.​
Or use the text import Excel feature from the Data menu and just well answer to its assistant …​
It should need less than 30 codelines.​
Dear I am unable to do it. Although, I have uploaded all related files in my thread. Pls refer to these, and help in fixing this issue.
Many Many thanks in advance
 
Also, alternatively, pls also provide code which works if I specify any particular folder to import multiple .txt files or csv files with same pattern.

I will really appreciate for your support from bottom of my heart.
Thanks so much for helping me out in your so busy schedule. God bless you guys.
 
rkbisht2019
Your Dear I am unable to do it.
for next time read
 
Thanks Sir...But, I want to achieve it using VBA. Since, I am looking for automatic functionality so that I just end up clicking on import and export button in excel. I hope my wish will come true in this platform.
 
I am looking for automatic functionality
I respect your desire to use VBA, however, to make sure you understand the capabilities of Power Query-->
Just for your information, this is possible by clicking on the Refresh All Button on the Data Tab when new data is added to the source data.
 
According to the attachment a beginner level VBA demonstration for starters to paste to the Sheet1 (Data) worksheet module
(a VBA beginner kid did the import part as a training with the Macro Recorder) :​
Code:
Sub Demo1()
    Dim P$, F$
        P = ThisWorkbook.Path & "\"
        F = Dir$(P & "*.txt"):  If F = "" Then Beep: Exit Sub
        UsedRange.Offset(1).Clear
        Application.ScreenUpdating = False
    Do
        With QueryTables.Add("TEXT;" & P & F, Cells(Rows.Count, 1).End(xlUp)(2))
            .AdjustColumnWidth = False
            .RefreshStyle = xlOverwriteCells
            .TextFileColumnDataTypes = [{3}]
            .TextFileDecimalSeparator = "."
            .TextFileParseType = 1
            .TextFileStartRow = 2
            .TextFileTabDelimiter = True
            .TextFileTextQualifier = xlTextQualifierNone
            .TextFileThousandsSeparator = ","
            .Refresh False
            .Delete
        End With
               F = Dir$
    Loop Until F = ""
        Application.ScreenUpdating = True
End Sub
Do you like it ? So thanks to click on bottom right Like !​
 
According to the attachment a beginner level VBA demonstration for starters to paste to the Sheet1 (Data) worksheet module
(a VBA beginner kid did the import part as a training with the Macro Recorder) :​
Code:
Sub Demo1()
    Dim P$, F$
        P = ThisWorkbook.Path & "\"
        F = Dir$(P & "*.txt"):  If F = "" Then Beep: Exit Sub
        UsedRange.Offset(1).Clear
        Application.ScreenUpdating = False
    Do
        With QueryTables.Add("TEXT;" & P & F, Cells(Rows.Count, 1).End(xlUp)(2))
            .AdjustColumnWidth = False
            .RefreshStyle = xlOverwriteCells
            .TextFileColumnDataTypes = [{3}]
            .TextFileDecimalSeparator = "."
            .TextFileParseType = 1
            .TextFileStartRow = 2
            .TextFileTabDelimiter = True
            .TextFileTextQualifier = xlTextQualifierNone
            .TextFileThousandsSeparator = ","
            .Refresh False
            .Delete
        End With
               F = Dir$
    Loop Until F = ""
        Application.ScreenUpdating = True
End Sub
Do you like it ? So thanks to click on bottom right Like !​
Dear It throws an error while executing above codes. Please dully check at your end.

Also, all working files are already in placed there.
 

Attachments

  • Error1.JPG
    Error1.JPG
    95 KB · Views: 7
Please dully check at your end.
Already checked before posting so your bad as you felt in the bad reader trap !​
As you did not follow the dark red direction where to paste the VBA procedure​
as it can't be located in any Module# but again in the worksheet module …​
 
Dear All,
Although, I don't visit this site frequently. But recently, my experienced changed a lot for this site. I don't find any relevant solution here. I found, people are more interested in passing comments rather providing solution.
It is my humble request, if someone can fix issue then only post here anything. Else, please neither waste your time nor mine.

Have a nice day ahead!
 
As you already receive some working solutions here ! The same well working on others threads …​
And as you can start yourself just activating the Macro Recorder and using the very easy import built-in Excel feature.​
If you do not understand anything just simply ask rather that any grumpy comment …​
 
I am not pin pointing to any individual one. Pls understand the gravity. You may also refer to my recent post and threads. I am not a VBA coder. If someone can fix this issue then please comment, else just chill.
 
There is no issue if you just well read (nothing to do with a VBA coder) & apply the direction …​
If you do not understand something, just ask and be explicit.​
 
Back
Top