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.)
Why
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
Where do I insert your script and what does it replace in mine? Thank you