Hello guys,

Several months back I was working on a spreadsheet to help with my tasks at work (while learning VBA in the process) and was mid project when circumstances caused me to put that project on hold. Now, 4-ish months later, I am trying to pick it back up and am having trouble figuring out where to go (and recalling the little I had started to learn about VBA in general).

I have some working VBA code that currently imports several .s2p files (specialty delimited text files) and copies them to a new workbook, each file in its own sheet.

The next step I need to accomplish is to modify what I have to make a version that only allows one file to be imported.

Below is a copy of my working "Private Sub multiple_s2p_new_sheet()" code as well as my non-functional "Private Sub single_s2p_this_sheet()" code as well as a few example .s2p files (special text files from data collection).

Any help or advice is appreciated.

In the next step I will need to solve, I will need to make a version of this code (both the single and multiple) that imports the files into new sheets within the current workbook instead of making them in a new workbook; advice on that step would also help me out. Thanks in advance!

Link to zip file containing several .s2p sample files.

Private Sub multiple_s2p_new_sheet()
    
    Dim xFilesToOpen    As Variant
    Dim i               As Integer
    Dim xWb             As Workbook
    Dim xTempWb         As Workbook
    Dim xDelimiter      As String
    Dim xScreen         As Boolean
    
    xScreen = Application.ScreenUpdating
    Application.ScreenUpdating = False ' turn off screen updating to make program run faster
    xFilesToOpen = Application.GetOpenFilename("Text Files (*.s2p), *.s2p", , "Import *.s2p files", , True) ' open file dialog box
    If TypeName(xFilesToOpen) = "Boolean" Then ' if filename is true or false (1 or 0)
        MsgBox "No files were selected", , "Import *.s2p files" ' then pop up message box saying no files were selected
        GoTo ExitHandler ' skip the next part and goto end of program tidying up
    End If
    i = 1
    Set xTempWb = Workbooks.Open(xFilesToOpen(i))
    xTempWb.Sheets(1).Copy
    Set xWb = Application.ActiveWorkbook
    xTempWb.Close False
    
   With Range("A:A")
      .Replace "!*", True, xlWhole, , , , False, False
      On Error Resume Next
      .SpecialCells(xlConstants, xlLogical).EntireRow.Delete
      On Error GoTo 0
   End With
   On Error Resume Next
   Rows(2).SpecialCells(xlBlanks).EntireColumn.Delete
   On Error GoTo 0
   Range("A1:I1").Value = Array("FREQUENCY", "S11 MAGNITUDE", "S11 PHASE", "S21 MAGNITUDE", "S21 PHASE", "S12 MAGNITUDE", "S21 PHASE", "S22 MAGNITUDE", "S22 PHASE")
   Range("A2:A1000000").TextToColumns _
      Destination:=Range("A2"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=True, _
      Tab:=False, Semicolon:=False, _
      Comma:=False, Space:=True, _
      Other:=True, OtherChar:=vbTab

    Do While i < UBound(xFilesToOpen)
        i = i + 1
        Set xTempWb = Workbooks.Open(xFilesToOpen(i))
         xTempWb.Sheets(1).Move after:=xWb.Sheets(xWb.Sheets.count)
         With Range("A:A")
            .Replace "!*", True, xlWhole, , , , False, False
            On Error Resume Next
            .SpecialCells(xlConstants, xlLogical).EntireRow.Delete
            On Error GoTo 0
         End With
         On Error Resume Next
         Rows(2).SpecialCells(xlBlanks).EntireColumn.Delete
         On Error GoTo 0
         Range("A1:I1").Value = Array("FREQUENCY", "S11 MAGNITUDE", "S11 PHASE", "S21 MAGNITUDE", "S21 PHASE", "S12 MAGNITUDE", "S21 PHASE", "S22 MAGNITUDE", "S22 PHASE")
         Range("A2:A1000000").TextToColumns _
         Destination:=Range("A2"), DataType:=xlDelimited, _
         TextQualifier:=xlDoubleQuote, _
         ConsecutiveDelimiter:=True, _
         Tab:=False, Semicolon:=False, _
         Comma:=False, Space:=True, _
         Other:=True, OtherChar:=vbTab

    Loop
ExitHandler:
    Application.ScreenUpdating = xScreen
    Set xWb = Nothing
    Set xTempWb = Nothing
    Exit Sub
End Sub

Private Sub single_s2p_this_sheet()
    
    Dim xFilesToOpen As Variant
    Dim i            As Integer
    Dim wb           As Workbook
    
    Set wb = ActiveWorkbook    ' this is the workbook the files should go into, instead of making a new workbook
    
    xFilesToOpen = Application.GetOpenFilename("Text Files (*.s2p), *.s2p", , "Import *.s2p files")    ' open file dialog box
    If TypeName(xFilesToOpen) = "Boolean" Then    'If no files are selected, the variant xFilesToOpen will be FALSE and be a Boolean-type variant instead of a string array type
        MsgBox "No files were selected", , "Import *.s2p files"    ' then pop up message box saying no files were selected
        GoTo ExitHandler    ' skip the next part and goto end of program tidying up
    End If
    
    Application.ScreenUpdating = False    ' turn off screen updating to make program run faster
    
    For i = 1 To UBound(xFilesToOpen)   'Loop through each selected file
        
        With Workbooks.Open(xFilesToOpen(i))
            .Sheets(1).Copy after:=wb.Sheets(wb.Sheets.count)
            .Close False
        End With
        
        With Range("A:A")
            .Replace "!*", True, xlWhole, , , , False, False
            On Error Resume Next
            .SpecialCells(xlConstants, xlLogical).EntireRow.Delete
            On Error GoTo 0
        End With
        On Error Resume Next
        Rows(2).SpecialCells(xlBlanks).EntireColumn.Delete
        On Error GoTo 0
        Range("A1:I1").Value = Array("FREQUENCY", "S11 MAGNITUDE", "S11 PHASE", "S21 MAGNITUDE", "S21 PHASE", "S12 MAGNITUDE", "S21 PHASE", "S22 MAGNITUDE", "S22 PHASE")
        Range("A2:A1000000").TextToColumns _
                Destination:=Range("A2"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, _
                ConsecutiveDelimiter:=True, _
                Tab:=False, Semicolon:=False, _
                Comma:=False, Space:=True, _
                Other:=True, OtherChar:=vbTab
        Range("A:A").NumberFormat = "0000"
        Range("B:B,D:D,F:F,H:H").NumberFormat = "00.000000"
        Range("C:C,E:E,G:G,I:I").NumberFormat = "000.0000"
       
    Next i 'open next file
    
ExitHandler:
    Application.ScreenUpdating = True
    Set xWb = Nothing
    Set xTempWb = Nothing
    
End Sub