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.

txt to excel

Discussion in 'VBA Macros' started by claudia80, Sep 30, 2017.

  1. claudia80

    claudia80 New Member

    Messages:
    16
    Hello
    I need your help.
    I would like to include in the excel file "GEONAMES - EXTRACT AND SETTING" a macro that converts the file text contained in the "GEONAMES - FILE TEXT" folder into excel files that will have the same text file names and will be placed in the "GEONAMES - FILE EXCEL ".
    When converting Excel files, i need:
    1) Format columns as text
    2) Provide conversion with character encoding 65001, utf-8;
    3) Foresee the alignment to the left of the data contained in the columns;
    4) Insert the following column headers into the file:

    GEONAMEID
    NAME
    ASCIINAME
    ALTERNATENAMES
    LATITUDE
    LONGITUDE
    FEATURE CLASS
    FEATURE CODE
    COUNTRY CODE
    CC2
    ADMIN1 CODE
    ADMIN2 CODE
    ADMIN3 CODE
    ADMIN4 CODE
    POPULATION
    ELEVATION
    DEM
    TIMEZONE
    DATE MODIFICATION

    5) Make sure the Excel excel text does not change the geographic coordinates columns as they are in the text file (I noticed that transformation can turn coordinates into numbers).
    For conversion code and points from number 1 to number 3 you may see the macro contained in the file you see here:
    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 = 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
     


    The macro must be activated by a button at the highlighted blue "GEONAMES - FILE EXCEL" text of the fiel excel.

    Thank you

    Link of the folder containing the excel file and excel text and text files:https://www.dropbox.com/s/aojqbkwv65enr0d/GEONAMES.7z?dl=0

    MOD EDIT: CODE TAGS ADDED
    Last edited by a moderator: Oct 1, 2017
  2. p45cal

    p45cal Well-Known Member

    Messages:
    822
    For (4) enter those headers in cells E2:W2 of ther EXTRACTIONS sheet, the code already handles this.
    For Text format and coordinates as text change:
    .TextFileColumnDataTypes = Array(1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    to:
    .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)

    If I get time I'll add converting to excel files in another folder.
  3. p45cal

    p45cal Well-Known Member

    Messages:
    822
    Is this an assignment?
  4. claudia80

    claudia80 New Member

    Messages:
    16
    thanks for your intervention, you have settled the question of the coordinates. I would like to include the list of point 4 in the macro and I would not want the macro to create the list of converted text files with its hyperlink.
  5. p45cal

    p45cal Well-Known Member

    Messages:
    822
    Point 4 I've already addressed - you code already handles point 4, you just have to give it something to work with. ('enter those headers in cells E2:W2 of the EXTRACTIONS sheet').


    Again, is this an assignment?
  6. claudia80

    claudia80 New Member

    Messages:
    16
    is a help request like the others that are in the forum
  7. claudia80

    claudia80 New Member

    Messages:
    16
    is there anyone?
  8. Kenneth Hobson

    Kenneth Hobson Member

    Messages:
    79
    p45cal knows more what you are doing than me.

    I added some structure and changed a few things so I could understand it better. It adds a workbook rather than a sheet and saved it for each file. I used an array to add the column titles.

    You will probably want to modify saving the name and link part.

    The xlsm runs from the parent folder where your xlsx file was at.
    Code (vb):

    Sub Main()
      ' constants
     ' declarations
     Dim tPath As String, tFile As String, xPath As String, sName As String
      Dim I As Long, A As String, wb As Workbook, t, r As Range

      ' start
     tPath = ThisWorkbook.Path & "\GEONAMES - FILE TEXT\"
      xPath = ThisWorkbook.Path & "\GEONAMES - FILE EXCEL\"
      Application.ScreenUpdating = False
      Application.EnableEvents = False
      Application.Calculation = xlCalculationManual
      ' Title Array
     t = Split("GEONAMEID,NAME,ASCIINAME,ALTERNATENAMES,LATITUDE" & _
        "LONGITUDE,FEATURE CLASS,FEATURE CODE,COUNTRY CODE,CC2" & _
        "ADMIN1 CODE,ADMIN2 CODE,ADMIN3 CODE,ADMIN4 CODE,POPULATION" & _
        "Elevation,DEM,TIMEZONE,Date MODIFICATION", ",")
      tFile = Dir(tPath & "*.txt")
      Do Until tFile = ""
        Set wb = Workbooks.Add
        On Error Resume Next
        sName = Left(tFile, InStr(tFile, ".") - 1)
        wb.ActiveSheet.Name = sName
        On Error GoTo 0
       
        'Let user know what file is being processed.
       Application.ScreenUpdating = True
        Application.StatusBar = "Processing " & sName & "..."
        Application.ScreenUpdating = False
        ' text file
       With wb.Worksheets(1).QueryTables.Add(Connection:="TEXT;" & tPath & _
          tFile, Destination:=Range("A2"))
          .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(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
          .TextFileTrailingMinusNumbers = True
          .Refresh BackgroundQuery:=False
        End With
        With wb.Worksheets(1).QueryTables
          .Item(.Count).Delete
        End With
        With wb.Worksheets(1).Cells
          .HorizontalAlignment = xlLeft
          .VerticalAlignment = xlBottom
          .WrapText = False
          .Orientation = 0
          .AddIndent = False
          .IndentLevel = 0
          .ShrinkToFit = False
          .ReadingOrder = xlContext
          .MergeCells = False
        End With
      ' titles
       wb.Worksheets(1).Range("A1").Resize(, UBound(t) + 1).Value = t
        ' link
       With ThisWorkbook.Worksheets(1)
          Set r = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
        End With
        r.Value = sName
        r.Offset(, 1).Hyperlinks.Add Anchor:=r.Offset(, 1), Address:="", _
          SubAddress:="'" & sName & "'!A1", TextToDisplay:=sName
       
        'Delete xlsx file if it exists
       On Error Resume Next
        Kill xPath & sName & ".xlsx"
        On Error GoTo 0
       
        ' Save and close wb as xlsx
       wb.SaveAs xPath & sName & ".xlsx", xlOpenXMLWorkbook
        wb.Close False
        ' cycle
       tFile = Dir()
      Loop

      ' end
     ThisWorkbook.Worksheets(1).Activate
      Range("A1").Select
      Beep
      Application.ScreenUpdating = True
      Application.EnableEvents = True
      Application.Calculation = xlCalculationAutomatic
      Application.StatusBar = False
    End Sub
     

    Attached Files:

  9. claudia80

    claudia80 New Member

    Messages:
    16
    Thank you very much
  10. Kenneth Hobson

    Kenneth Hobson Member

    Messages:
    79
    For the extras that you asked for in a PM, at the end are the modified parts. I changed the alignment to center for the title cells, bolded them, and added the autofilter. I changed the link to link to the xlsx files created in column B.

    As for the the other parts of your project detailed in the PM, most forums discourage off-forum things like that. Feel free to start another thread. You can post a link to this thread if some may relate for an overall picture. Most will not help you with a big project. That is what paid consultants are for. Howsoever, you can be sneaky and post parts of your project. A new concept deserves a new thread. e.g. (1) Importing csv files, massage data and formats, and save as xlsx files. (2) Download csv files from website. (3) etc.

    Code (vb):

      ' titles
       With wb.Worksheets(1).Range("A1").Resize(, UBound(t) + 1)
          .Value = t
          .AutoFilter  'Turn on autofilter
         .Font.Bold = True
          .HorizontalAlignment = xlCenter 'Keep?
         .VerticalAlignment = xlCenter 'Keep?
         .EntireColumn.AutoFit 'Keep? Titles can be bigger than content.
       End With
       
        ' link
       With ThisWorkbook.Worksheets(1)
          Set r = .Cells(.Rows.Count, "B").End(xlUp).Offset(1)
        End With
        r.Hyperlinks.Add Anchor:=r, Address:=xPath & sName & ".xlsx", _
          SubAddress:="'" & sName & "'!A1", TextToDisplay:=sName
    If you need what you sent me in the PM, I can copy and send it back in a PM.
  11. claudia80

    claudia80 New Member

    Messages:
    16
    Hello guys
    If I replace the "title" section last attached, within the macro, the results are not the ones you want.
    Why?
  12. Kenneth Hobson

    Kenneth Hobson Member

    Messages:
    79
    What I want means nothing. I can post the full sub later tonight or you. Can post an example file for What you want. Note that there are two title sections. The first is names and this latest is for format. Was that not obvious?
  13. Kenneth Hobson

    Kenneth Hobson Member

    Messages:
    79
    Code (vb):
    Sub Main()
      ' constants
     ' declarations
     Dim tPath As String, tFile As String, xPath As String, sName As String
      Dim I As Long, A As String, wb As Workbook, t, r As Range

      ' start
     tPath = ThisWorkbook.Path & "\GEONAMES - FILE TEXT\"
      xPath = ThisWorkbook.Path & "\GEONAMES - FILE EXCEL\"
     
      Application.ScreenUpdating = False
      Application.EnableEvents = False
      Application.Calculation = xlCalculationManual
     
      ' Title Array
     t = Split("GEONAMEID,NAME,ASCIINAME,ALTERNATENAMES,LATITUDE" & _
        "LONGITUDE,FEATURE CLASS,FEATURE CODE,COUNTRY CODE,CC2" & _
        "ADMIN1 CODE,ADMIN2 CODE,ADMIN3 CODE,ADMIN4 CODE,POPULATION" & _
        "Elevation,DEM,TIMEZONE,Date MODIFICATION", ",")
     
      tFile = Dir(tPath & "*.txt")
      Do Until tFile = ""
        Set wb = Workbooks.Add
        On Error Resume Next
        sName = Left(tFile, InStr(tFile, ".") - 1)
        wb.ActiveSheet.Name = sName
        On Error GoTo 0
       
        'Let user know what file is being processed.
       Application.ScreenUpdating = True
        Application.StatusBar = "Processing " & sName & "..."
        Application.ScreenUpdating = False
     
        ' text file
       With wb.Worksheets(1).QueryTables.Add(Connection:="TEXT;" & tPath & _
          tFile, Destination:=Range("A2"))
          .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(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
          .TextFileTrailingMinusNumbers = True
          .Refresh BackgroundQuery:=False
        End With
     
        With wb.Worksheets(1).QueryTables
          .Item(.Count).Delete
        End With
     
        With wb.Worksheets(1).Cells
          .HorizontalAlignment = xlLeft
          .VerticalAlignment = xlBottom
          .WrapText = False
          .Orientation = 0
          .AddIndent = False
          .IndentLevel = 0
          .ShrinkToFit = False
          .ReadingOrder = xlContext
          .MergeCells = False
        End With
     
      ' titles
       With wb.Worksheets(1).Range("A1").Resize(, UBound(t) + 1)
          .Value = t
          .AutoFilter  'Turn on autofilter
         .Font.Bold = True
          .HorizontalAlignment = xlCenter
          .VerticalAlignment = xlCenter
          .EntireColumn.AutoFit
        End With
       
        ' link
       With ThisWorkbook.Worksheets(1)
          Set r = .Cells(.Rows.Count, "B").End(xlUp).Offset(1)
        End With
        r.Hyperlinks.Add Anchor:=r, Address:=xPath & sName & ".xlsx", _
          SubAddress:="'" & sName & "'!A1", TextToDisplay:=sName
       
        'Delete xlsx file if it exists
       On Error Resume Next
        Kill xPath & sName & ".xlsx"
        On Error GoTo 0
       
        ' Save and close wb as xlsx
       wb.SaveAs xPath & sName & ".xlsx", xlOpenXMLWorkbook
        wb.Close False
     
        ' cycle
       tFile = Dir()
      Loop

      ' end
     ThisWorkbook.Worksheets(1).Activate
      Range("A1").Select
      Beep
     
      Application.ScreenUpdating = True
      Application.EnableEvents = True
      Application.Calculation = xlCalculationAutomatic
      Application.StatusBar = False
    End Sub
  14. claudia80

    claudia80 New Member

    Messages:
    16
    Good morning Mr. Hobson.
    I corrected his macro.
    I replaced this part:

    t = Split ("GEONAMEID, NAME, ASCIINAME, ALTERNATENAMES, LATITUDE" & _"LONGITUDE, FEATURE CLASS, FEATURE CODE, COUNTRY CODE, CC2" & _"ADMIN1 CODE, ADMIN2 CODE, ADMIN3 CODE, ADMIN4 CODE,POPULATION" & _ "Elevation, DEM, TIMEZONE, Date MODIFICATION", ",")

    with this:

    t = Split ("GEONAMEID, NAME, ASCIINAME, ALTERNATENAMES, LATITUDE, LONGITUDE, FEATURE CLASS, FEATURE CODE, COUNTRY CODE, CC2, ADMIN1 CODE, ADMIN2 CODE, ADMIN3 CODE, ADMIN4 CODE, POPULATION, ELEVATION, DEM, TIMEZONE, DATE MODIFICATION ",", ")

    could the titles be highlighted in yellow and not create hyperlinks in the "EXTRACTIONS" sheet?
  15. Kenneth Hobson

    Kenneth Hobson Member

    Messages:
    79
    If you want a long line, the t split you posted is fine. I like my code to be readable in a half pane while viewing the Excel file. If you have two monitors, maybe that works for you. Some forums I used in the past made the review block scroll then so I code in blocks by habit for another reason.

    For your sheet command button help, Form and ActiveX controls are used. There are many good tutorials for that. Search for "excel tutorial command buttons".

    For minor changes like those in #14, a recorded macro will show you the syntax. Well, close to it anyway. I tried to set it in title commented block sections so you can see what is happening where. So, we are back to the last two sections towards the end again. Note that even though I commented out the Hyperlink addition, if you just delete a former hyperlink, a text value will still be a hyperlink to nowhere. Use the Clear All to delete formats and values.

    Code (vb):
    ' titles
       With wb.Worksheets(1).Range("A1").Resize(, UBound(t) + 1)
          .Value = t
          .AutoFilter  'Turn on autofilter
         .Font.Bold = True
          .HorizontalAlignment = xlCenter
          .VerticalAlignment = xlCenter
          .EntireColumn.AutoFit
          .Interior.Color = vbYellow
        End With

        ' link
       With ThisWorkbook.Worksheets(1)
          Set r = .Cells(.Rows.Count, "B").End(xlUp).Offset(1)
        End With
        'r.Hyperlinks.Add Anchor:=r, Address:=xPath & sName & ".xlsx", _
          SubAddress:="'" & sName & "'!A1", TextToDisplay:=sName
       r.Value = sName
    Tip: See the tip above a potential reply to see how to type code tags and paste code there. Or more easily, in the 2nd row of the reply menu, click the first icon and paste there. It is a neat feature of this forum.
    Last edited: Oct 12, 2017 at 4:06 PM
  16. claudia80

    claudia80 New Member

    Messages:
    16
    Good morning, Mr. Kenneth Hobson.
    I followed her advice and I did it.
    I have been able to insert macros start buttons and removed the "link" part of the code to avoid creating the converted file list with its hyperlink.

    the conversion macro is useful because if you restart the macro to transform updated files, the old files (with the same name) are automatically deleted
    Last edited: Oct 13, 2017 at 10:35 AM

Share This Page