Closing a specific file

Keala

New Member
Joined
Jul 9, 2018
Messages
37
I have folder with many files, which the code below is applied on.
So the process is to select the folder which have the files. The code open first *.txt file in excel, do some calculations save the *.txt file to *.xls file (Waveform_Freq-140.0_PC-10.0_KKC-2.0_180817-143116), copy/paste calculation result to a different open *.xls file (Joined_PC_Level_I) and loop this through the entire folder. But it keep all opened *.xls files, which the calculations was done on open (Waveform_Freq-140.0_PC-10.0_KKC-2.0_180817-143116).
How do I do to close the *.xls file which the recent calculations were done on. So populate all the necessary fields in the Joined_PC_Level_I.xlsx but have closed all the *.xlsx files which was opened and calculated one by one. (the memory gets full to have many excel files open at the same time and then the code pop a alert code and stops)

I have tried with some different options but nothing do the work. I have marked the lines which I think need to be updated for doing what I want to do.

Thank you for any suggestions and improvments

Code:
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=4][COLOR=#00ff00]    Application.Workbooks("filename").Activate[/COLOR][/SIZE]
[SIZE=4][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
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Forum statistics

Threads
1,215,043
Messages
6,122,825
Members
449,096
Latest member
Erald

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top