1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. 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...

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

Copy and paste multiple text excel files on the same file with hyperlink and table titles

Discussion in 'VBA Macros' started by stefanoste78, May 21, 2017.

  1. stefanoste78

    stefanoste78 Member

    Messages:
    69
    Good morning.

    I have more txt files. It is possible to create a macro that opens many pages excel (in the same file) how many text files are in the "text" folder on the desktop and paste the contents of each text file on each excel page.

    The macro should not only import the data on every excel page, but it must also include the title of the columns, which I will put in the "list" page. If I modify the name of the columns on the page list or insert new columns one day, the table columns of all the pages in the excel file will automatically be updated.

    Once done this I would like to have hyperlinks that return to the page with the same name.

    I attach an example

    ps. I do not have the right knowledge to create macros.

    Attached Files:

  2. Belleke

    Belleke Member

    Messages:
    128
    Hi,
    See attached (unzip it first)
    I think I covered the things you asked for.
    Edit: no need to open the textfiles

    Attached Files:

  3. stefanoste78

    stefanoste78 Member

    Messages:
    69
    good morning.

    I tried the macro however I noticed that the data is not fully aligned. There is no problem with the size of the file.

    I have tried to manually open the text file, then I clicked on "edit all" and then on "copy" from the edit menu. After I glued it to the excel cell a1 and it all goes well.

    Why is this not the case with the macro?

    thank you
  4. stefanoste78

    stefanoste78 Member

    Messages:
    69
    Is there anyone who can improve this macro? Unfortunately the result of importing from the excel text file is not the same as copying and pasting from excel text files.
  5. SirJB7

    SirJB7 Excel Rōnin

    Messages:
    8,890
    Hi, stefanoste78!
    Consider uploading a sample text file. It'd be easier to understand for people who might be able to help you.
    Include a manually written output of the requested solution. Thanks.
    Regards!
  6. stefanoste78

    stefanoste78 Member

    Messages:
    69

    Good morning.

    You are right…

    This is the text file:

    https://www.dropbox.com/s/ax5efm20pzbi354/IT.txt?dl=0

    Instead this is the excel file I got by opening the text file, then selecting all the content (by editing) and pasting everything on excel, starting from cell "A2".

    The contents of the cells of the times are aligned to the left to the right. Is it also possible to get the alignment to the left?

    https://www.dropbox.com/s/bo4bskmk5vg8kkt/IT.xlsx?dl=0

    Thank you
  7. SirJB7

    SirJB7 Excel Rōnin

    Messages:
    8,890
    Hi, stefanoste78!

    Give a try at the attached file, this is the VBA code:

    Code (vb):
    Option Explicit

    Sub ImportTextFileTabSeparatedNewSheets()
        ' constants
       ' declarations
       Dim sPath As String, sFile As String, sName As String
        Dim I As Integer, A As String
        ' start
       sPath = ThisWorkbook.Path
        sFile = Dir(sPath & "\*.txt")
        With ThisWorkbook
            Worksheets(.Worksheets.Count).Activate
        End With
        ' process
       Do Until sFile = ""
            ' worksheet
           ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
            On Error Resume Next
            sName = Left(sFile, InStr(sFile, ".") - 1)
            ActiveSheet.Name = sName
            On Error GoTo 0
            ' text file
           With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sPath & "\" & sFile, Destination:=Range("$A$2"))
                .Name = sName
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = 1252
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierNone
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = True
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = False
                .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
            End With
            ' titles
           I = 1
            With ActiveSheet
                Do While Worksheets(1).Cells(2, I + 4).Value <> ""
                    .Cells(1, I).Value = Worksheets(1).Cells(2, I + 4).Value
                    I = I + 1
                Loop
            End With
            ' link
           With Worksheets(1)
                .Activate
                I = .Cells(1, 1).End(xlDown).End(xlDown).End(xlUp).Row + 1
                .Cells(I, 1).Value = sName
                .Cells(I, 2).Select
                .Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & sName & "'!A1", TextToDisplay:=sName
            End With
            ' cycle
           sFile = Dir()
        Loop
        ' end
       ThisWorkbook.Worksheets(1).Activate
        Range("A1").Select
        Beep
    End Sub
    Regards!

    PS: BTW, it's in Spanish?

    Attached Files:

    Chirag R Raval and NARAYANK991 like this.
  8. stefanoste78

    stefanoste78 Member

    Messages:
    69
    Hello.
    The file covers the countries in italy.
    I tried your macro. The data is pasted in order. Unfortunately, however, there are two problems to be solved:

    1) The text files will be a 250 and the macro at a certain point will hang up by giving an error message;
    2) There are some character recognition issues.

    I attach the files relating to the two problems

    Attached Files:

    • 1.JPG
      1.JPG
      File size:
      16.3 KB
      Views:
      5
    • 2.xlsx
      File size:
      8.9 KB
      Views:
      1
  9. SirJB7

    SirJB7 Excel Rōnin

    Messages:
    8,890
    Hi stefanoste78!

    I thought it was in Italian, it's just that the word "elenco" made me doubt. It's Spanish and I thought that in Italian it was "lanciare" o "cast" only.

    Regarding 1) let me check it for performance enhancements.
    Regarding 2) please upload the related text file in .txt format.

    Regards!
  10. stefanoste78

    stefanoste78 Member

    Messages:
    69
    They are all txt files. Fixed you have to set the character encoding type that changes for some of the alphabets.

    Can also align the cell contents to the left?

    Thank you
  11. SirJB7

    SirJB7 Excel Rōnin

    Messages:
    8,890
    Hi, stefanoste78!

    Regarding 1): copy this code after With...EndWith of "' text file" segment:
    Code (vb):
            With ActiveSheet.QueryTables
                .Item(.Count).Delete
            End With
    Regarding 2): copy this code after "' title" segment:
    Code (vb):
        ActiveSheet.Cells.Select
        With Selection
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
    Regards!
  12. stefanoste78

    stefanoste78 Member

    Messages:
    69
    Hi
    I will put the excel file with your changes.
    Basically, the opening phase of text files has improved. Up to 160 250-file files arrive, but then it crashes and exits the out-of-memory 7 runtime error mask.
    Cell content aligns to the left, however, does not recognize special characters. You can try the file I have attached to you. It would be a general characterization procedure. Is this the last thing feasible?
    See you soon

    Attached Files:

  13. SirJB7

    SirJB7 Excel Rōnin

    Messages:
    8,890
    Hi, stefanoste78!
    It's due to different types (origin or source) of .txt files. Text files have an attribute called origin or source which indicates which alphabet (set of characters) has to be used to properly open it. The first file had 1252 (Windows ANSI) and the last 65001 (Unicode UTF-8). And I don't know any way of retrieving it to be used as you require here, so if you have files that you want to process in the same pass I'm afraid you're in trouble.
    Regards!
    NARAYANK991 likes this.
  14. stefanoste78

    stefanoste78 Member

    Messages:
    69
    good morning
    The solution to the problem ... transform the cell contents into text to exclude anything from excel and 65001 UTF8 encoding.
    The problem remains that on 247 files only opens 163, it will be tied to the ram.
    Should I divide the folder into three but then could I join them by getting the result I set for?
    See you soon



    Option Explicit

    Sub ImportTextFileTabSeparatedNewSheets()
    ' constants
    ' declarations
    Dim sPath As String, sFile As String, sName As String
    Dim I As Integer, A As String
    ' start
    sPath = ThisWorkbook.Path
    sFile = Dir(sPath & "\*.txt")
    With ThisWorkbook
    Worksheets(.Worksheets.Count).Activate
    End With
    ' process
    Do Until sFile = ""
    ' worksheet
    ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
    On Error Resume Next
    sName = Left(sFile, InStr(sFile, ".") - 1)
    ActiveSheet.Name = sName
    On Error GoTo 0
    ' text file
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sPath & "\" & sFile, Destination:=Range("$A$2"))
    .Name = sName
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 65001
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierNone
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
    End With
    With ActiveSheet.QueryTables
    .Item(.Count).Delete
    End With
    ' titles
    I = 1
    With ActiveSheet
    Do While Worksheets(1).Cells(2, I + 4) <> ""
    .Cells(1, I) = Worksheets(1).Cells(2, I + 4)
    I = I + 1
    Loop
    End With
    ActiveSheet.Cells.Select
    With Selection
    .HorizontalAlignment = xlLeft
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    ' link
    With Worksheets(1)
    .Activate
    I = .Cells(1, 1).End(xlDown).End(xlDown).End(xlUp).Row + 1
    .Cells(I, 1).Value = sName
    .Cells(I, 2).Select
    .Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & sName & "'!A1", TextToDisplay:=sName
    End With
    ' cycle
    sFile = Dir()
    Loop
    ' end
    ThisWorkbook.Worksheets(1).Activate
    Range("A1").Select
    Beep
    End Sub
  15. SirJB7

    SirJB7 Excel Rōnin

    Messages:
    8,890
    Hi, stefanoste78!

    When posting code, please embed it into code tags, 5th icon from the right in the light blue bar just above the text box where you write.

    I didn't test if but if the results seem to suit your requirements then go ahead. Just a comment: 1252 and 65001 are not the only text sources, there are a lot of them. From Excel, Data tab, From Text icon, select a text file, and check the source drop down combo box.

    Regarding procedures that replace diacritic characters with "normal" characters, like https://www.mrexcel.com/forum/excel-questions/1008104-replacing-special-characters-geo.html, you're loosing information, i.e., it's not the same "años" than "anos" (check a Spanish dictionary). I do not recommend so, I'd rather group the text files by its source and then process each group using the proper code.

    Regards!
    Chirag R Raval likes this.
  16. stefanoste78

    stefanoste78 Member

    Messages:
    69
    Formatting the cell as a text not by character encoding problems. If so, any character is excel as it is on the text file. Right?
  17. SirJB7

    SirJB7 Excel Rōnin

    Messages:
    8,890
    Hi, stefanoste!
    There's no such a thing as Excel characters. Characters in text files have 1-byte values or 2-byte values for Unicode for examples. Excel reads the text file according the source type that the file specifies or that you set up by code.
    Regards!
  18. stefanoste78

    stefanoste78 Member

    Messages:
    69
    Is there no solution if you do not copy and paste manually? As you wrote, you should look for the type of encoding each time. It seems hard to do ..
  19. SirJB7

    SirJB7 Excel Rōnin

    Messages:
    8,890
  20. stefanoste78

    stefanoste78 Member

    Messages:
    69
    you are right.

Share This Page