Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.
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