Sleeper: Clean and speed up code.

[stapuff]

I am looking to clean and speed up this code (not that it takes very long). I have about 15 macro's I will using for a large program. I need to reduce as much time as possible.

I appreciate everything that can be done.

Kurt

Public Sub Button20_Click()
Dim strSourceFolder As String
strSourceFolder = "o:\ow_ftp\"
    ChDrive Left$(strSourceFolder, 2)
    ChDir strSourceFolder
    FName = Application.GetOpenFilename(filefilter:="Text files (*.txt),o:\ow_ftp\*.txt", Title:="Get report to email")
    If FName = "False" Then Exit Sub
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Workbooks.OpenText Filename:=FName, Origin:=xlWindows, _
    StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), _
            Array(3, 1), Array(5, 1), Array(12, 1), Array(20, 1), Array(52, 1), _
            Array(63, 1), Array(79, 1), Array(95, 1), Array(106, 1), Array(130, 1))
    ChDir "S:\Production Control"
    ActiveWorkbook.SaveAs Filename:="S:\Production Control\Production Schedule Download.csv", _
    FileFormat:=xlCSVMSDOS, CreateBackup:=False
    ActiveWindow.Close
    Application.DefaultFilePath = origDefaultPath
    Sheets("Download").Select
    Range("A2:K5000").ClearContents
    Workbooks.Open Filename:="S:\Production Control\Production Schedule Download.csv"
    Range("A1:K5000").Copy
    Windows("Production Report.xls").Activate
    Sheets("Download").Select
    Range("A1").PasteSpecial
    Windows("Production Schedule Download.csv").Activate
    ActiveWindow.Close
    Workbooks.Open Filename:="S:\Production Control\Planning Requirements.xls"
    Sheets("sheet1").Select
    Range("A2:J5000").ClearContents
    Windows("Production Report.xls").ActivateSheets("Download").Select
    Columns("A:J").EntireColumn.AutoFit
    Application.CutCopyMode = False
    Application.ScreenUpdating = False
    ActiveSheet.AutoFilterMode = False
    Range("A2:J5000").Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Range("A2").Select
Dim rng As Range
    Set rng = Range("A1:K" & Range("A5000").End(xlUp).Row)
    rng.AutoFilter Field:=2, Criteria1:=">1", Operator:=xlOr, Criteria2:="<>0"
    On Error Resume Next
    With rng
        rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    Err.Clear
    ActiveSheet.AutoFilterMode = False
    Set rng = Nothing
    Set rng = Range("A1:K" & Range("f5000").End(xlUp).Row)
    rng.AutoFilter Field:=4, Criteria1:="="
    On Error Resume Next
    With rng
        rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    Err.Clear
    ActiveSheet.AutoFilterMode = False
    Set rng = Range("A1:K" & Range("A5000").End(xlUp).Row)
    rng.AutoFilter Field:=1, Criteria1:="=Z*", Operator:=xlAnd, Criteria2:="<>ZW"
    On Error Resume Next
    With rng
        rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    Err.Clear
    ActiveSheet.AutoFilterMode = False
    Set rng = Nothing
    Application.ScreenUpdating = True
    Application.ScreenUpdating = False
    Call texttonegative
    Kill (FName)
    UserForm1.Show


Private Sub texttonegative()
Dim MemberCell As Range
For Each MemberCell In ActiveSheet.UsedRange
        If Right(MemberCell.Formula, 1) = "-" Then
            MemberCell.Value = -Trim(Left(MemberCell, Len(MemberCell) - 1))
        End If
    Next
End Sub

[Norie]

I don't know if it will speed things up but you don't need to select/activate ranges/workbooks/sheets.

Option Explicit
Public Sub Button20_Click()
	 
	Dim strSourceFolder As String
	 
	strSourceFolder = "o:\ow_ftp\"
	ChDrive Left$(strSourceFolder, 2)
	ChDir strSourceFolder
	FName = Application.GetOpenFilename(filefilter:="Text files (*.txt),o:\ow_ftp\*.txt", Title:="Get report to email")
	If FName = "False" Then Exit Sub
	Application.ScreenUpdating = False
	Application.DisplayAlerts = False
	Workbooks.OpenText Filename:=FName, Origin:=xlWindows, _
	StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), _
	Array(3, 1), Array(5, 1), Array(12, 1), Array(20, 1), Array(52, 1), _
	Array(63, 1), Array(79, 1), Array(95, 1), Array(106, 1), Array(130, 1))
	ChDir "S:\Production Control"
	ActiveWorkbook.SaveAs Filename:="S:\Production Control\Production Schedule Download.csv", _
	FileFormat:=xlCSVMSDOS, CreateBackup:=False
	ActiveWindow.Close
	Application.DefaultFilePath = origDefaultPath
	Sheets("Download").Range("A2:K5000").ClearContents
	Workbooks.Open Filename:="S:\Production Control\Production Schedule Download.csv"
	Range("A1:K5000").Copy Workbooks("Production Report.xls").Sheets("Download").Range("A1")
	Workbooks("Production Schedule Download.csv").Close
	Workbooks.Open Filename:="S:\Production Control\Planning Requirements.xls"
	Sheets("sheet1").Range("A2:J5000").ClearContents
	Workbooks("Production Report.xls").Worksheets("Download").Columns("A:J").EntireColumn.AutoFit
	Application.CutCopyMode = False
	Application.ScreenUpdating = False
	ActiveSheet.AutoFilterMode = False
	Range("A2:J5000").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, _
	OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
	 
	Dim rng As Range
	Set rng = Range("A1:K" & Range("A5000").End(xlUp).Row)
	rng.AutoFilter Field:=2, Criteria1:=">1", Operator:=xlOr, Criteria2:="<>0"
	On Error Resume Next
	With rng
		rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
	End With
	Err.Clear
	ActiveSheet.AutoFilterMode = False
	Set rng = Nothing
	Set rng = Range("A1:K" & Range("f5000").End(xlUp).Row)
	rng.AutoFilter Field:=4, Criteria1:="="
	On Error Resume Next
	With rng
		rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
	End With
	Err.Clear
	ActiveSheet.AutoFilterMode = False
	Set rng = Range("A1:K" & Range("A5000").End(xlUp).Row)
	rng.AutoFilter Field:=1, Criteria1:="=Z*", Operator:=xlAnd, Criteria2:="<>ZW"
	On Error Resume Next
	With rng
		rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
	End With
	Err.Clear
	ActiveSheet.AutoFilterMode = False
	Set rng = Nothing
	Application.ScreenUpdating = True
	Application.ScreenUpdating = False
	Call texttonegative
	Kill (FName)
	UserForm1.Show