Sub DoIt() Dim fld As FileDialog Dim sFolderLoc As String Dim iCurrentRow As Long Dim i As Long Dim sTxtFilename As String Dim j As Long Dim sLine As String Dim sComputedResults Dim sComputedMaximum Dim sComputedMinimum With ThisWorkbook.ActiveSheet .Range("A1") = "File Name" .Range("B1") = "Computed Results" .Range("C1") = "Blank" .Range("D1") = "Computed Maximum" .Range("E1") = "Computed Minimum" End With iCurrentRow = 1 'sFolderLoc = ThisWorkbook.ActiveSheet.Cells(2, 9).Value 'Set fld = Application.FileDialog(msoFileDialogFolderPicker) 'open file picker instead of a folder picker Set fld = Application.FileDialog(msoFileDialogFilePicker) 'set file picker dialog preferences With fld .Title = "Pick your file type" .AllowMultiSelect = False 'you may want to comment out the next two lines if you want to allow users to select a variety of file types .Filters.Clear .Filters.Add "Text Files", "*.data" If .Show <> -1 Then GoTo Exit_DoIt sFolderLoc = fld.SelectedItems(1) End With 'sTxtFilename = ThisWorkbook.ActiveSheet.Cells(2, 10).Value 'set file type based upon what the user has selected sTxtFilename = "*." & Right(sFolderLoc, Len(sFolderLoc) - InStrRev(sFolderLoc, ".")) sComputedResults = "Computed Results: " sComputedMaximum = "Computed Maximum: " sComputedMinimum = "Computed Minimum: " 'set folder based upon location of file user has selected sFolderLoc = Left(sFolderLoc, InStrRev(sFolderLoc, "\")) ' this assumes all files of type data are your data sTxtFilename = Dir(sFolderLoc & "\" & sTxtFilename) Do While sTxtFilename <> "" iCurrentRow = iCurrentRow + 1 Open sFolderLoc & "\" & sTxtFilename For Input As #1 ' no error checking here, assumes all txt files are ok Do While Not EOF(1) Input #1, sLine If Left(sLine, Len(sComputedResults)) = sComputedResults Then sLine = Right(sLine, Len(sLine) - Len(sComputedResults)) ThisWorkbook.ActiveSheet.Range("B" & iCurrentRow) = sLine ElseIf Left(sLine, Len(sComputedMaximum)) = sComputedMaximum Then sLine = Right(sLine, Len(sLine) - Len(sComputedMaximum)) ThisWorkbook.ActiveSheet.Range("D" & iCurrentRow) = sLine ElseIf Left(sLine, Len(sComputedMinimum)) = sComputedMinimum Then sLine = Right(sLine, Len(sLine) - Len(sComputedMinimum)) ThisWorkbook.ActiveSheet.Range("E" & iCurrentRow) = sLine End If Loop ThisWorkbook.ActiveSheet.Range("A" & iCurrentRow) = sTxtFilename Close #1 'find next txt file sTxtFilename = Dir Loop Exit_DoIt: Set fld = Nothing End Sub
|Display the VBA Userform in Screen Center||4||30|
|How to change the following 2nd comma in each line to a tilde (~) in Excel 2016?||6||42|
|Hard coding time and date into Excel||2||30|
|remove lower case characters in excel formula||12||22|
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
12 Experts available now in Live!