title: VBA - Activate open file
body: <p>I have a working macro that loops through folder to open files and get important info from the columns of names "HOLDER" and "CUTTING TOOL" and printing all the info to one excel document, masterfile. It also prints the file name into column 1 and the name of the "Tooling Data Sheet" to column 4.</p>
  
  <p>I am creating a button that runs a search on one file that you can type into a textbox. It works perfectly except it opens a file, reads it, and leaves it open. I want it to close the file but my masterfile is the active sheet. I cannot set the open file as a specific name because it needs to open whatever one file I open, not just one specific file. </p>
  
  <p>Any ideas how to switch the active sheet without a specific name?</p>
  
  <pre><code>Private Sub CommandButton1_Click()
  
  
  'Set folder path where the file is located
  Const TDS_PATH = "C:\Users\trembos\Documents\TDS\progress\"
  
  'Clear out any info on current page
  Sheets("Sheet1").Range("A2:D7557").Clear
  
  'TextBox1.Text = ".xlsx"
  'TextBox1.Font.Italic = True
  
  'input checking
  If TextBox1.Text = "" Then
      MsgBox ("Please enter a file to search for")
  End If
  
  
  'Dim WB As Workbook
  'Set WB = Workbooks.Open(objFile.Name, UpdateLinks:=0)
  'Set ws = WB.ActiveSheet
  
  
  'If the File we are searching for exists in the path
  If TextBox1.Text &lt;&gt; "" Then
  
      'Disable screen updating for performance/aesthetics
      Application.ScreenUpdating = False
  
      'Open the workbook we searched for (ReadOnly)
      Workbooks.Open TDS_PATH &amp; TextBox1.Text, ReadOnly:=True
      Set Workbook = ThisWorkbook
  
      'Copy the range we are interested in
  
  
  
      Const ROW_HEADER As Long = 10
  
      Dim objFSO As Object
      Dim objFolder As Object
      Dim objFile As Object
      Dim MyFolder As String
      Dim StartSht As Worksheet, ws As Worksheet
      Dim WB As Workbook
      Dim i As Integer
      Dim LastRow As Integer, erow As Integer
      Dim Height As Integer
      Dim FinalRow As Long
      Dim f As String
      Dim dict As Object
      Dim hc As Range, hc1 As Range, hc2 As Range, hc3 As Range, hc4 As Range, hc5 As Range, d As Range
  
      Set StartSht = Workbooks("masterfile.xlsm").Sheets("Sheet1")
  
      MyFolder = "C:\Users\trembos\Documents\TDS\progress\"
  
      Set hc1 = HeaderCell(StartSht.Range("B1"), "HOLDER")
      Set hc2 = HeaderCell(StartSht.Range("C1"), "CUTTING TOOL")
  
  
      'create an instance of the FileSystemObject
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      'get the folder object
      Set objFolder = objFSO.GetFolder(MyFolder)
  
      i = 2
  
          'Set WB = Workbooks
          Set ws = ActiveSheet
  
          Set hc = HeaderCell(ws.Cells(ROW_HEADER, 1), "CUTTING TOOL")
          If Not hc Is Nothing Then
  
              Set dict = GetValues(hc.Offset(1, 0), "SplitMe")
              If dict.count &gt; 0 Then
                  Set d = StartSht.Cells(Rows.count, hc2.Column).End(xlUp).Offset(1, 0)
                  'add the values to the master list, column 3
                  d.Resize(dict.count, 1).Value = Application.Transpose(dict.items)
              End If
          Else
              'header not found on source worksheet
          End If
  '(4)
          'find HOLDER on the source sheet
          Set hc3 = HeaderCell(ws.Cells(ROW_HEADER, 1), "HOLDER")
          If Not hc3 Is Nothing Then
              Set dict = GetValues(hc3.Offset(1, 0))
              'If InStr(ROW_HEADER, "HOLDER") &lt;&gt; "" Then
              If dict.count &gt; 0 Then
                  Set d = StartSht.Cells(Rows.count, hc1.Column).End(xlUp).Offset(1, 0)
                  'add the values to the master list, column 2
                  d.Resize(dict.count, 1).Value = Application.Transpose(dict.items)
              End If
              'End If
          Else
              'header not found on source worksheet
          End If
  
  '(5)
      With ws
          'print TDS information
                  'print the file name to Column 1
                  StartSht.Cells(i, 1) = TextBox1.Text
                  StartSht.Range(StartSht.Cells(i, 1), StartSht.Cells(GetLastRowInColumn(StartSht, "C"), 1)) = TextBox1.Text
  
                  'print TDS name from J1 cell to Column 4
                  'With ws
                      .Range("J1").Copy StartSht.Cells(i, 4)
                      .Range("J1").Copy StartSht.Range(StartSht.Cells(i, 4), StartSht.Cells(GetLastRowInColumn(StartSht, "C"), 4))
                  'End With
                  i = GetLastRowInSheet(StartSht) + 1
          'move to next file
  '(6)
          'close, do not save any changes to the opened files
          StartSht.d 'SaveChanges:=False
      End With
  
  End If
  
  '(7)
  'turn screen updating back on
  ActiveWindow.ScrollRow = 1
  
      'Re-enable screen updating
      Application.ScreenUpdating = True
  
      'Let the user know if the file is not found
  If TextBox1.Text = "" Then
      MsgBox ("File not found!")
  End If
  
  End Sub
  
  'Private Sub TextBox1_GotFocus()
  '    TextBox1.Text = ""
  '    TextBox1.Font.Italic = False
  'End Sub
  
  '(8)
  'get all unique column values starting at cell c
  Function GetValues(ch As Range, Optional vSplit As Variant) As Object
      Dim dict As Object
      Dim rng As Range, c As Range
      Dim v
      Dim spl As Variant
  
      Set dict = CreateObject("scripting.dictionary")
  
      For Each c In ch.Parent.Range(ch, ch.Parent.Cells(Rows.count, ch.Column).End(xlUp)).Cells
          v = Trim(c.Value)
          If Len(v) &gt; 0 And Not dict.exists(v) Then
  
              'exclude any info after ";"
              If Not IsMissing(vSplit) Then
              spl = Split(v, ";")
              v = spl(0)
              End If
  
              'exclude any info after ","
              If Not IsMissing(vSplit) Then
              spl = Split(v, ",")
              v = spl(0)
              End If
  
              dict.Add c.Address, v
          End If
      Next c
      Set GetValues = dict
  End Function
  
  '(9)
  'find a header on a row: returns Nothing if not found
  Function HeaderCell(rng As Range, sHeader As String) As Range
      Dim rv As Range, c As Range
      For Each c In rng.Parent.Range(rng, rng.Parent.Cells(rng.Row, Columns.count).End(xlToLeft)).Cells
          'copy cell value if it contains some string "holder" or "cutting tool"
          If InStr(c.Value, sHeader) &lt;&gt; 0 Then
              Set rv = c
              Exit For
          End If
      Next c
      Set HeaderCell = rv
  End Function
  
  '(10)
  Function GetLastRowInColumn(theWorksheet As Worksheet, col As String)
      With theWorksheet
          GetLastRowInColumn = .Range(col &amp; .Rows.count).End(xlUp).Row
      End With
  End Function
  
  
  '(11)
  Function GetLastRowInSheet(theWorksheet As Worksheet)
  Dim ret
      With theWorksheet
          If Application.WorksheetFunction.CountA(.Cells) &lt;&gt; 0 Then
              ret = .Cells.Find(What:="*", _
                            After:=.Range("A1"), _
                            LookAt:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
          Else
              ret = 1
          End If
      End With
      GetLastRowInSheet = ret
  End Function
  </code></pre>