23180

VBA - Activate open file

Question:

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.

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.

Any ideas how to switch the active sheet without a specific name?

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 <> "" Then 'Disable screen updating for performance/aesthetics Application.ScreenUpdating = False 'Open the workbook we searched for (ReadOnly) Workbooks.Open TDS_PATH & 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 > 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") <> "" Then If dict.count > 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) > 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) <> 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 & .Rows.count).End(xlUp).Row End With End Function '(11) Function GetLastRowInSheet(theWorksheet As Worksheet) Dim ret With theWorksheet If Application.WorksheetFunction.CountA(.Cells) <> 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

Answer1:

You already have the answer in your code:<br />set wb=workbooks.open...<br /> and when you don't need it anymore just wb.close.

Another approach could be to loop through all open workbook's and check their names:<br />For Each wb In Application.Workbooks<br /> If wb.name=textbox1.text Then wb.close<br /> Next wb

Recommend

  • How to make replace function loops for all the files in the same folder (same directory)? [duplicate
  • Get the last modified file from a folder with specific extension in vbs
  • Importing .csv to MS Access. “AtEndOfStream” doesn't read last line
  • Linked Excel Object in Powerpoint wont update when showing in slideshow
  • Asynchronous issue with OBJLoader - wait for XHR to finish loading
  • Formatting with Charts
  • Export data from Excel to Access using VBA
  • vba paste values and keep source formatting?
  • Yahoo finance historical stock price power query returns 301 response
  • How to sort things out in ListView?
  • How do `pass` and `listen` work in WriterT?
  • Nodejs bluebird promise fails while processing image
  • SSIS Designer is running VERY slowly
  • OpenMP and File I/O
  • Most efficient way to replace lowest list values in dataframe in R
  • Save image as is in photo album using swift
  • Are there any side effects from calling SQLAlchemy flush() within code?
  • Sybase Error Implicit Conversion from datatype 'VARCHAR' to 'INT' not allowed
  • sweetalert2 inputoptions from file in select example
  • git add error : “fatal : malloc, out of memory”
  • Elasticsearch script query involving root and nested values
  • Custom preprocessing in caret
  • How to make JSON.NET deserialize to Microsoft Date Time?
  • Using a canvas object in a thread to do simple animations - Java
  • Unable to get column index with table.getColumn method using custom table Model
  • How to add git credentials to the build so it would be able to be used within a shell code?
  • How can the INSERT … ON CONFLICT (id) DO UPDATE… syntax be used with a sequence ID?
  • Groovy: Unexpected token “:”
  • Transactional Create with Validation in ServiceStack Redis Client
  • Hardware Accelerated Image Scaling in windows using C++
  • How to create a file in java without a extension
  • Extracting HTML between tags
  • Avoid links criss cross / overlap in d3.js using force layout
  • javaw.exe and eclipse startup problems
  • MySQL WHERE-condition in procedure ignored
  • Run Powershell script from inside other Powershell script with dynamic redirection to file
  • Load html files in TinyMce
  • How can I get HTML syntax highlighting in my editor for CakePHP?
  • Suggestions to manage Login/Logout transitions
  • coudnt use logback because of log4j