Re-activate a open workbook in a loop

  • I have the code below which is mostly copy/paste since I'm very new to VBA.

    What I want the program to do:
    Let say I have a folder with three files name 1, 2, 3.txt and a joined_123.xls. I want to open file1 convert it to *.xls do some calculations, save it as *.xls move the calculation result to joined_123, close file 1. Open file 2 do the same calculation and movement to the joined_123 close file 2 and so on.

    What the code does:
    As the code do in below it open file 1 do the calculations and movement to the joined_123 file but keep the file 1 open. Then it opens file 2 do the same thing and so on.

    What I need help with:
    How do I re-activate the first opened file and close it before opening file 2. I want it to only keep joined_123 open and populate fields from the files without keeping each file open. (I have highlighted the part which I think need to be improved, but I might be totally wrong as well, since none of the ways I have tried have worked.)

    I have many files which this needs to be applied on. The way it is now I can only do the code for ~90 *.xls files then I will run out of memory and a alert popup.

    Thank you for any improvement suggestions

    Sub Macro1openwaveformfiles() ' ' Macro1 Macro ' ' Keyboard Shortcut: Ctrl+r '   screenUpdateState = Application.ScreenUpdating statusBarState = Application.DisplayStatusBar calcState = Application.Calculation eventsState = Application.EnableEvents displayPageBreakState = ActiveSheet.DisplayPageBreaks 'note this is a sheet-level setting 'turn off some Excel functionality so your code runs faster Application.ScreenUpdating = False Application.DisplayStatusBar = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False 'note this is a sheet-level setting   Dim MyFolder As String  Dim myFile As String  Dim folderName As String  Dim Workbook As String  Dim filename As String  Dim c As Long  Dim k As Long  Dim j As Long  Dim p As Long  Dim d As Long    c = 4  j = 4  k = 2  p = 3  d = 3    With Application.FileDialog(msoFileDialogFolderPicker)  .AllowMultiSelect = False  If .Show = -1 Then    folderName = .SelectedItems(1)  End If  End With    myFile = Dir(folderName & "\*.txt")    Do While myFile <> ""  Workbooks.OpenText filename:=folderName & "\" & myFile, Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _         xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _         Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _         TrailingMinusNumbers:=True  Cells.Select     Selection.Replace What:=".", Replacement:=".", LookAt:=xlPart, _     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _     ReplaceFormat:=False 'ActiveWorkbook.SaveAs Filename:=folderName & "\" & Replace(myfile, ".txt", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False    Range("A300038").Select     ActiveCell.FormulaR1C1 = "Max"     Range("A300039").Select     ActiveCell.FormulaR1C1 = "Min"     Range("B300038").Select     ActiveCell.FormulaR1C1 = "=MAX(R[-300003]C:R[-1]C)"     Range("B300038").Select     Selection.AutoFill Destination:=Range("B300038:C300038"), Type:= _         xlFillDefault     Range("B300038:C300038").Select     Selection.AutoFill Destination:=Range("B300038:C300039"), Type:= _         xlFillDefault     Range("B300038:C300039").Select     Range("B300039").Select     ActiveCell.FormulaR1C1 = "=MIN(R[-300003]C:R[-1]C)"     Range("C300039").Select     ActiveCell.FormulaR1C1 = "=MIN(R[-300003]C:R[-1]C)"     Range("C300040").Select     ActiveWindow.SmallScroll Down:=12     Range("B300040").Select     Application.CutCopyMode = False     ActiveCell.FormulaR1C1 = "=R[-2]C-R[-1]C"     Range("B300040").Select     Selection.AutoFill Destination:=Range("B300040:C300040"), Type:= _         xlFillDefault     Range("B300040:C300040").Select     Range("A300040").Select     ActiveCell.FormulaR1C1 = "Diff"     Range("A300041").Select     filename = ActiveWorkbook.Name  ActiveWorkbook.SaveAs filename:=folderName & "\" & Replace(myFile, ".txt", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False        Range("B300038:B300040").Copy     Windows("Joined_DC_Level_I.xlsx").Activate     Cells(j, c).Select             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _         :=False, Transpose:=False     p = j - 1     Cells(p, c).Select          ActiveCell.FormulaR1C1 = filename     d = j - 2     Cells(d, c).Select     ActiveCell.FormulaR1C1 = "DC" & k     c = c + 1     k = k + 2          If k = 18 Then      k = 2     End If          If c = 12 Then      c = 4      j = j + 5     End If          'ThisWorkbook.SaveAs     ActiveWorkbook.Save [size=14][COLOR=#00ff00]    Application.Workbooks("filename").Activate[/COLOR][/SIZE] [size=14][COLOR=#00ff00]    ActiveWorkbook.Close SaveChanges:=True[/COLOR][/SIZE]     'ActiveWorkbook.SaveAs Filename:=folderName & "\" & Replace(myfile, ".txt", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False  'wb.Close False  'Ensure Workbook has closed before moving on to next line of code   DoEvents    'Get next file name   myFile = Dir  Loop    'ThisWorkbook.SaveAs True     For Each wb In Workbooks         If wb.Name <> ThisWorkbook.Name Then             'wb.SaveAs Filename:=Path & wb.Name             ', FileFormat:=51            wb.Close False         End If     Next wb     'ThisWorkbook.Close False    Application.ScreenUpdating = screenUpdateState   Application.DisplayStatusBar = statusBarState   Application.Calculation = calcState   Application.EnableEvents = eventsState   ActiveSheet.DisplayPageBreaks = displayPageBreaksState 'note this is a sheet-level setting       End Sub
  • you have "" into your code remove it..

    Application.Workbooks("filename").Activate ' <-- will not give you file name
    Application.Workbooks(filename).Activate   '<-- this will
  • Thank you ashu1990 for the suggestion. Unfortunately this change only pop a alert code, with text

    Run-time error '9'
    Subscript out of range.

    When selecting debug it select the above changed line.

    Could you please advice what needs to be improved.

    Thank you,

  • ok here is the problem you are having old file name when it was opened and after you saved the workbook with its new name you did not again loaded the variable with the new file name.

    Filename = ActiveWorkbook.Name
    ActiveWorkbook.SaveAs Filename:=FolderName & "\" & Replace(myFile, ".txt", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    change this to this

    ActiveWorkbook.SaveAs Filename:=FolderName & "\" & Replace(myFile, ".txt", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Filename = ActiveWorkbook.Name

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!