Speeding up

[Keala]

I need to apply below code on about 3000 files and each file have 300K rowsx 4columns. With the code below each file take about 5 minutes to complete, so to do this on all files will take me couple days. Is there a way to make this happen faster?
(I need to also add, I'm very new to VBA and below code is a copy/paste code but it works, just very slow for the purpose.)
Any help or direction were to read more about it is appreciated, Thank you.

Sub Macro1openwaveformfiles()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+r
'
Dim MyFolder As String
 Dim myfile As String
 Dim folderName As String
 Dim c As Long
 Dim k As Long
 c = 4
 k = 2


 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
 
 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
 ActiveWorkbook.SaveAs Filename:=folderName & "\" & Replace(myfile, ".txt", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
 
 
    Range("B300038:B300040").Select
    Selection.Copy
    ActiveWindow.Close
   
    
    Windows("Joined_PC_Level.xlsx").Activate
    Cells(3, c).Select
    
ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, _
        DisplayAsIcon:=False, NoHTMLFormatting:=True
    c = c + 1


 'Ensure Workbook has closed before moving on to next line of code
  DoEvents


 'Get next file name
  myfile = Dir
 Loop
End Sub

 

[fhqwgads]

something about avoiding volatile functions like using active cells and selections. i'm not too familiar with it myself but someone will surely swooce right in any moment with a link to the relevant thread explaining everything in detail. i think it mostly boils down to things like instead of using

    Range("B300038:B300040").Select
    Selection.Copy

you just shorten it to

    Range("B300038:B300040").Copy

 

[Keala]

Thank you Fgqwgads, I will implement your suggestion. But I think what is most time demanding is the "." to "," change, please let me know how I can optimize it. I have added some extra lines in the code below which should speed up, and it does but not significantly.

Any further suggestions on how to speed it up even more is appreciated.

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 c As Long
 Dim k As Long
 c = 8
 k = 2


 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


 
 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
 ActiveWorkbook.SaveAs Filename:=folderName & "\" & Replace(myfile, ".txt", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
 
 
    Range("B300038:B300040").Copy
    Windows("Joined_PC_Level.xlsx").Activate
    Cells(3, c).Select
    
   
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    c = c + 1
    'ThisWorkbook.SaveAs
    ActiveWorkbook.Save
  
 '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