locked
How to write VBA code to select text files and display the data in current sheet, also how to set criteria for selecting text files, i.e., user can select more than 1 file but less than 10. RRS feed

  • General discussion

  • Hi,

    I wanted to select text files and display all the data from selected text files in Sheet 2 and display chart accordingly in Sheet 1, also got to set selection criteria for user, i.e., user can select more than 1 but less than 10 text files. I got a piece of code which select a folder instead of files and display all the text files data in that folder in a sheet. But I want to select files with the criteria mentioned instead of folder, cause folder contain more than 20 files.

    Can someone help me to modify the code to accomplish the given task. Thank you!

    The code i got is:

    --------------------------

    Sub Alpha_A()

    Dim myWB As Workbook, wb As Workbook
    Set myWB = ThisWorkbook
    Dim fPath As String, fName As String
    On Error Resume Next

    With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "please, select One folder"
    .AllowMultiSelect = False

    If .Show = True Then
    fPath = .SelectedItems(1) & "\"

    fName = Dir(fPath & "*.txt")

    If fName <> "" Then
    Application.ScreenUpdating = False
    Do Until fName = ""
    Application.DisplayAlerts = False
    myWB.Sheets(fName).Delete
    Application.DisplayAlerts = True
    Workbooks.OpenText Filename:=fPath & fName, DataType:=xlDelimited, Tab:=True
    Set wb = ActiveWorkbook
    wb.Sheets(1).Copy after:=myWB.Sheets(myWB.Sheets.Count)
    myWB.Sheets(myWB.Sheets.Count).Name = fName
    wb.Close True
    fName = Dir()
    Loop
    Application.ScreenUpdating = True

    Call clearcelldata
    Call WorksheetLoop

    Worksheets(1).Activate

    Call Sheetdelete
    'Call closeallwb

    Else
    MsgBox "no files"
    End If
    Else
    MsgBox "Cancel"
    End If
    End With
    End Sub

    ----------------------------

    .............worksheetloop module

    Sub WorksheetLoop()

    Dim WS_Count As Integer
    Dim I As Integer
    Dim str As String

    WS_Count = ActiveWorkbook.Worksheets.Count
    'I = 2
    For I = 3 To WS_Count
                
    'Worksheets(I + 2).Activate
    Worksheets(I).Activate
    str = Worksheets(I).Name
    str = Mid(Worksheets(I).Name, 7, 8)

    Range("B2:B3").Select
    Application.CutCopyMode = False
    Selection.Copy

    Worksheets(2).Activate

    Range("A2").Select

    Do Until ActiveCell.Value = ""
    ActiveCell.Offset(1, 0).Select
    Loop

    ActiveCell.Value = str
    ActiveCell.Offset(0, 1).Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True

    Next I

    --------------------------

    If anything required let me know.


    • Edited by Jayeshh Sunday, October 5, 2014 11:01 PM
    Sunday, October 5, 2014 10:23 PM

All replies

  • Re:  open text files using FileDialog object

    See how this works for you...
    '---
    Sub DoSomethingWithTextFiles()
        Dim fd As FileDialog
        Dim strFilePath As String
        Dim N As Long
        Dim M As Long
        
        Set fd = Application.FileDialog(msoFileDialogFilePicker)
        fd.AllowMultiSelect = True
        fd.Filters.Add "Text", "*.txt", 1
        fd.InitialFileName = "C:\"
        fd.ButtonName = "Continue"
        fd.InitialView = msoFileDialogViewList
      
        If fd.Show = -1 Then
          N = fd.SelectedItems.Count
          If N > 10 Then N = 10
          For M = 1 To N
           strFilePath = fd.SelectedItems.Item(M)
           Workbooks.Open strFilePath
          Next
        End If
        Set fd = Nothing
    End Sub
    '---

    Jim Cone
    Portland, Oregon USA
    https://goo.gl/IUQUN2 (Dropbox)
    (free & commercial excel add-ins & workbooks)

    • Edited by James Cone Tuesday, November 1, 2016 2:48 AM
    Monday, October 6, 2014 1:29 AM
  • Hi James,

    Thanks for your reply, but here I got this code which opens text files, but it opens separate workbooks for each text files. I want it to open in current sheet itself instead of different workbooks. See if you can help me out with this code to modify it.

    Previous code which I gave "Alpha_A()" do the same. It opens the text files in current sheet, but it allows me to select folder instead of files.

    If you can be able to modify both the codes to select text files and open the sheets in same current sheet with user restriction will be great.

    Here is that piece of code which open text files, but opens in different workbooks. See if you can modify this so that i can open in current sheet.

    Thanks James

    -----------------------

    Sub CombineTextFiles()
    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    sDelimiter = "|"

    FilesToOpen = Application.GetOpenFilename _
    (filefilter:="Text Files (*.txt), *.txt", _
    MultiSelect:=True, Title:="Text Files to Open")

    If TypeName(FilesToOpen) = "Boolean" Then
    MsgBox "No Files were selected"
    GoTo ExitHandler
    End If

    x = 1

    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    wkbTemp.Sheets(1).Copy

    Set wkbAll = ActiveWorkbook
    wkbTemp.Close (True)
    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
    Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=False, Semicolon:=False, _
    Comma:=False, Space:=False, _
    Other:=True, OtherChar:="|"
    x = x + 1

    While x <= UBound(FilesToOpen)

    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    With wkbAll
    wkbTemp.Sheets(1).Move after:=.Sheets(.Sheets.Count)
    .Worksheets(x).Columns("A:A").TextToColumns _
    Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=False, Semicolon:=False, _
    Comma:=False, Space:=False, _
    Other:=True, OtherChar:=sDelimiter
    End With
    x = x + 1
    Wend

    ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub

    ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler

    End Sub

    Monday, October 6, 2014 6:04 AM
  • Probably cleaner simply to import multiple text files to the same workbook as a temporary connection. Following includes your max ten files at a time, you might want to adapt the sheet naming method and anything else in the connection as required.

    Sub TextFilesToWorkbook()
    Dim i As Long, pos As Long, k As Long
    Dim vFiles
    Dim sName As String
    Dim sDelimiter As String
    Dim ws As Worksheet
    Dim wb As Workbook
    
    Dim qt As QueryTable
        Set wb = ActiveWorkbook
        sDelimiter = "|"  ' < adapt
    
        vFiles = Application.GetOpenFilename _
                 (filefilter:="Text Files (*.txt), *.txt", _
                  MultiSelect:=True, Title:="Text Files to Open")
    
        If VarType(vFiles) = vbBoolean Then
            ' user canceled
            Exit Sub
        ElseIf UBound(vFiles) > 10 Then
            If MsgBox("Import max first 10?", vbOKCancel) = vbOK Then
                ReDim Preserve vFiles(1 To 10)
            Else
                Exit Sub
            End If
        End If
    
        For i = 1 To UBound(vFiles)
            pos = InStrRev(vFiles(i), "\")
            sName = Mid(vFiles(i), pos + 1, 100)
            sName = Left(sName, Len(sName) - 4)
    
            Set ws = wb.Worksheets.Add(AFTER:=wb.Sheets(wb.Sheets.Count))
    
            On Error Resume Next
            ws.Name = sName
            k = 0
            While Err.Number
                Err.Clear
                k = k + 1
                ws.Name = sName & " (" & k & ")"
            Wend
    
            Set qt = ws.QueryTables.Add("TEXT;" & vFiles(i), Range("$A$1"))
            With qt
    ' adapt as required
                .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 = 437 ' ?
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = True
                .TextFileSpaceDelimiter = False
                .TextFileOtherDelimiter = sDelimiter
                .TextFileColumnDataTypes = Array(1, 1, 1)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
                .Delete
            End With
        Next
    End Sub
    

    Monday, October 6, 2014 10:18 AM
  • Hey Peter,

    Thanks a lot for the code, it works perfect. Only thing when i select more than 10 files it just pops the message and display 10 sheets....

    In this case, if i select more than 10 files, it should pop up the message and takes the control back to file dialog. What say.

    Thanks Pete

    Monday, October 6, 2014 10:40 AM
  • Can't reselect the previous selection in the dialog if too many files so would need to start over. Following is just one of many ways to go about it, adapt if you don't want to allow the option to import the first 10 selected files. Always give the user a chance to abort, in this case can if Cancel the file dialog

    Dim sMsg
    
    
        While VarType(vFiles) < vbArray
            vFiles = Application.GetOpenFilename _
                     (filefilter:="Text Files (*.txt), *.txt", _
                      MultiSelect:=True, Title:="Text Files to Open")
            If VarType(vFiles) = vbBoolean Then
                ' user canceled
                Exit Sub
            ElseIf UBound(vFiles) > 10 Then
                sMsg = "Press OK to import max first files 10 only" & vbCr
                For i = 1 To UBound(vFiles)
                    sMsg = sMsg & "  " & vFiles(i) & vbCr
                Next
                sMsg = sMsg & vbCr & "Press Cancel to start again"
                If MsgBox(sMsg, vbOKCancel) = vbOK Then
                    ReDim Preserve vFiles(1 To 10)
                Else
                    vFiles = False ' reset the variant array
                End If
            End If
        Wend
    

    Monday, October 6, 2014 12:08 PM
  • Hi Peter,

    Your code works really fine. Also if you can help me out with chart thing. In Sheet 1 i got a chart with its data range in sheet 2. So, whenever I select text files, the data is stored in sheet 2, and accordingly the data range from sheet 2 is used to display chart. So, how to programmatically select all the data. Cause first time if i select 5 text files, the chart is displayed according to those 5 files data (this is done manually), but next time when i select 8 text files, it shows only data range for the first selection, i.e., for 5 text files data. Is there any way to select the data range for that chart till last row and display the chart.

    My columns are like this.

    A B C

    1 Date Amount 1 Amount 2 Total

    2 20141010   100 100 200

    3 20140607   300 400 700

    and so on.

    Also, how to convert column A data to date format.

    Your help is appreciated.

    Thanks 

    Monday, October 6, 2014 4:22 PM
  • sample table format is here

    Date Amount 1 Amount 2 Total
    20140523 200 50 250
    20140524 140 100 240
    20140630 400 130 530
    20140805 200 98 298
    20140806 150 98 248
    Monday, October 6, 2014 4:25 PM
  • This appears to be a new question unrelated to your original question, albeit part of your same project. Is your original question answered? If so could you ask your new question as a new topic.
    Tuesday, October 7, 2014 12:43 PM
  • Yep..done
    Wednesday, October 8, 2014 2:46 PM
  • So is your original question answered?
    Wednesday, October 8, 2014 4:07 PM
  • Ya Peter, you and James have been a great help! I'm just at my learning stage, got some of the tasks accomplished by doing R&D and all. But still long way to go to be an expert like you guys. ;)
    Wednesday, October 8, 2014 4:10 PM