ThisWorkbook.Select traits help

[epslugger]

Hi all,
I am a self taught VB programmer that is new to this forum so bear with me if my question seems simple, but it should be easy to answer.
I have been creating a macro in file called "converter.xlsm" that converts a database file (example: data.csv) to one that I can input into an assembly line software(example: Job1.xls). The macro:
1. Asks the user to select a saved file from the database
2. Creates a new Workbook and imports the data from the selected file
3. Asks the used to save the workbook
4. Rearranges the data and adds additional data from a "Master List" tab contained in "converter.xlsm"
5. Deletes any Jobs that have already been converted in a previous file by comparing the new workbook to a "run jobs" tad in "converter.xlsm"

My problem comes from number 4. I am using ThisWorkbook.select and ActiveWorkbook.select to go back and forth between "converter.xlsm" and the new workbook respectively I haveny had a problem with this method until now. My code is listed below and the problem lines are . One of the problem lines calls a function at the bottom of the code that is written in blue. If anyone has suggestion of a better method that maybe doesn't include .select it would be greatly appreciated. Thanks

Private Sub UserForm_Initialize()
'PREFACE: USER FORM
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'SETTING UP CHECK BOXES
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
CheckBox1.Value = True
CheckBox2.Value = True
CheckBox3.Value = True
CheckBox4.Value = False
CheckBox5.Value = True
CheckBox6.Value = False
'If IsDate(ActiveCell.Value) Then
' Calander1.Value = ActiveCell.Value
' Delete_Date = Calander1.Value
'End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'SETTING UP SORT OPTIONS
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''Empty Sort By: List
'ComboBox1.Clear
'ComboBox1.Value = "Name"
''Fill Sort By: List
'With ComboBox1
'.AddItem "Name"
'.AddItem "OS"
'.AddItem "Date"
'End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'ENDING HOUSE CLEANING
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''Set Focus on NameTextBox
'CheckBox1.SetFocus
End Sub




Private Sub Progress_Window_Initialize()


Label1.Value = "Process: Starting Up"
ProgressBar1.Value = 10
ProgressBar1.Maximum = 100
ProgressBar1.Minimum = 0


End Sub








'Index


'PREFACE: USER FORM
'CHAPTER 1: OPENING SAP REPORT AND SAVING PTL FILE
'CHAPTER 2: IMPORTING DATA
'CHAPTER 3: REMOVING INVALID BUILDS
'CHAPTER 4: JIT SHEET
'CHAPTER 5: CLOSING HOUSE KEEPING




Private Sub OKButton_Click()
Dim Row_Count As Integer
'CHAPTER 1: OPENING SAP REPORT AND SAVING PTL FILE
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Beggining House Keeping & Error Proofing
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Close the UserForm Dialog
Unload Me
'Create New Excel WorkBook
Application.ScreenUpdating = False
Workbooks.Add
'Rename Sheet1
ActiveSheet.Name = "import"
'Open the "Open file" Dialog
Sheets("Sheet3").Select
Dim AccReport As String
AccReport = Application.GetOpenFilename(FileFilter:="CSV Files(*.csv*),*.csv*", Title:="Select a SAP BV Report")
'Exit the macro if the cancel button is pressed
If AccReport = "False" Then
MsgBox ("No File Selected: File Not Converted.")
ActiveWorkbook.Close
Exit Sub
Else
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Open File Dialog
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & AccReport, Destination:=Range("A1"))
.Name = "Orderxxxxx"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierNone
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Dim NewFile As String
Dim NewFileType As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Save As Dialog
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
NewFileType = "Excel Files 2007 (*.xls), *.xls," & "All files (*.*), *.*"
NewFile = Application.GetSaveAsFilename(InitialFileName:="BVOrder_" & Format$(Date, "mm-dd-yyyy") & "_" & Format$(Time, "hh\hnn\mAM/PM"), FileFilter:=NewFileType)
If NewFile <> "" And NewFile <> "False" Then
ActiveWorkbook.SaveAs Filename:=NewFile, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Else
MsgBox ("File Name not Specified: File Not Converted")
ActiveWorkbook.Close
Exit Sub
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Ending House keeping
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Turn off screen updating
' Application.ScreenUpdating = False
'Replace Commas
' Progress_Window.Active = True
Cells.Replace What:=",", Replacement:="-", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'Deleting empty rows in "import" for 1st time (zone 1)
Dim d1 As Long
For d1 = Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1
If Cells(d1, 3) = "" Then Rows(d1).Delete
Next d1
'Figuring out how long "sheet3" is
'(*will not read correctly is empty cells in colomn A still exist) (zone 2)
Sheets("Sheet3").Select
Row_Count = Count_Rows(Row_Count)
'Autofit Sheet 3
Columns("A:Z").Select
Columns("A:Z").EntireColumn.AutoFit
Rows("1:1000").Select
Rows("1:1000").EntireRow.AutoFit
'CHAPTER 2: IMPORTING DATA
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Give Sheet 1 (import) Headings
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim i13 As Integer
i13 = Row_Count
Sheets("import").Select
Range("A1").FormulaR1C1 = "Name"
Range("B1").FormulaR1C1 = "OS"
Range("C1").FormulaR1C1 = "Qty"
Range("D1").FormulaR1C1 = "Priority"
Range("E1").FormulaR1C1 = "Date"
Range("F1").FormulaR1C1 = "OS Number"
Range("G1").FormulaR1C1 = "Order Number"
Range("H1").FormulaR1C1 = "Order Line"
Range("I1").FormulaR1C1 = "Tag"
Range("J1").FormulaR1C1 = "Hold"
Range("K1").FormulaR1C1 = "KitID"
Range("L1").FormulaR1C1 = "Size"
Range("M1").FormulaR1C1 = "CV"
Range("N1").FormulaR1C1 = "Actuator P/N"
Range("O1").FormulaR1C1 = "Valve P/N"
Range("P1").FormulaR1C1 = "Description1"
Range("Q1").FormulaR1C1 = "Description2"
Range("R1").FormulaR1C1 = "UPC"
Range("S1").FormulaR1C1 = "Pack Type"
Range("T1").FormulaR1C1 = "SCS"
Range("U1").FormulaR1C1 = "Website"
Range("V1").FormulaR1C1 = "QR Code"
Range("W1").FormulaR1C1 = "Valve Barcode"
Range("X1").FormulaR1C1 = "GRIS CODE"
Range("Y1").FormulaR1C1 = "TOTAL QTY"
Range("Z1").FormulaR1C1 = "REQUEST DATE"
Range("AA1").FormulaR1C1 = "Job No"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Data From SAP Report
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For i13 = Row_Count To 2 Step -1
Range("A" & i13).Value = Sheets("Sheet3").Range("D" & i13).Value & "-" & Sheets("Sheet3").Range("E" & i13).Value
Range("B" & i13).Value = Sheets("Sheet3").Range("C" & i13).Value
Range("C" & i13).Value = Sheets("Sheet3").Range("B" & i13).Value
' If Sheets("Sheet3").Range("H" & i13).Value = "EMERGENCY" Then
' Range("D" & i13).Value = 8
' Else
Range("D" & i13).Value = 1
' End If
Range("E" & i13).Value = Sheets("Sheet3").Range("A" & i13).Value
Range("F" & i13).Value = Sheets("Sheet3").Range("C" & i13).Value
Range("G" & i13).Value = Sheets("Sheet3").Range("D" & i13).Value
Range("H" & i13).Value = Sheets("Sheet3").Range("E" & i13).Value
Range("I" & i13).Value = Sheets("Sheet3").Range("J" & i13).Value
If Sheets("Sheet3").Range("K" & i13).Value = "TRUE" Then
Range("J" & i13).Value = "TRUE"
Else
Range("J" & i13).Value = "FALSE"
End If
Range("K" & i13).Value = Sheets("Sheet3").Range("C" & i13).Value
Range("Y" & i13).Value = Sheets("Sheet3").Range("B" & i13).Value
Range("Z" & i13).Value = Sheets("Sheet3").Range("A" & i13).Value
Range("AA" & i13).Value = Sheets("Sheet3").Range("H" & i13).Value
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Data From Master List
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Res As Variant
Res = Application.VLookup(Sheets("import").Range("B" & i13).Value, ThisWorkbook.Sheets("Master List").Range("A2:AZ2000"), 6, False)
If IsError(Res) = False Then
Range("L" & i13).Value = Res
Else
Range("L" & i13).Value = "Not Found"
End If
Res = Application.VLookup(Sheets("import").Range("B" & i13).Value, ThisWorkbook.Sheets("Master List").Range("A2:AZ2000"), 5, False)
If IsError(Res) = False Then
Range("M" & i13).Value = Res
Else
Range("M" & i13).Value = "Not Found"
End If
Res = Application.VLookup(Sheets("import").Range("B" & i13).Value, ThisWorkbook.Sheets("Master List").Range("A2:AZ2000"), 2, False)
If IsError(Res) = False Then
Range("N" & i13).Value = Res
Else
Range("N" & i13).Value = "Not Found"
End If
Res = Application.VLookup(Sheets("import").Range("B" & i13).Value, ThisWorkbook.Sheets("Master List").Range("A2:AZ2000"), 7, False)
If IsError(Res) = False Then
Range("O" & i13).Value = Res
Else
Range("O" & i13).Value = "Not Found"
End If
Res = Application.VLookup(Sheets("import").Range("B" & i13).Value, ThisWorkbook.Sheets("Master List").Range("A2:AZ2000"), 3, False)
If IsError(Res) = False Then
Range("P" & i13).Value = Res
Else
Range("P" & i13).Value = "Not Found"
End If
Res = Application.VLookup(Sheets("import").Range("B" & i13).Value, ThisWorkbook.Sheets("Master List").Range("A2:AZ2000"), 4, False)
If IsError(Res) = False Then
Range("Q" & i13).Value = Res
Else
Range("Q" & i13).Value = "Not Found"
End If
Res = Application.VLookup(Sheets("import").Range("B" & i13).Value, ThisWorkbook.Sheets("Master List").Range("A2:AZ2000"), 9, False)
If IsError(Res) = False Then
Range("R" & i13).Value = "'" & Res
Else
Range("R" & i13).Value = "Not Found"
End If
Res = Application.VLookup(Sheets("import").Range("B" & i13).Value, ThisWorkbook.Sheets("Master List").Range("A2:AZ2000"), 8, False)
If IsError(Res) = False Then
Range("S" & i13).Value = Res
Else
Range("S" & i13).Value = "Not Found"
End If
Res = Application.VLookup(Sheets("import").Range("B" & i13).Value, ThisWorkbook.Sheets("Master List").Range("A2:AZ2000"), 10, False)
If IsError(Res) = False Then
Range("T" & i13).Value = "'" & Res
Else
Range("T" & i13).Value = "Not Found"
End If
Res = Application.VLookup(Sheets("import").Range("B" & i13).Value, ThisWorkbook.Sheets("Master List").Range("A2:AZ2000"), 11, False)
If IsError(Res) = False Then
Range("U" & i13).Value = Res
Else
Range("U" & i13).Value = "Not Found"
End If
Range("V" & i13).Value = Range("U" & i13).Value & "Cv-" & Range("M" & i13).Value & " Size:" & Range("L" & i13).Value & " Valve:" & Range("O" & i13).Value & "Actuator:" & Range("N" & i13).Value & " TagInfo:" & Range("J" & i13).Value & " Line-" & Range("I" & i13).Value & " SO#:" & Range("G" & i13).Value
Res = Application.VLookup(Sheets("import").Range("B" & i13).Value, ThisWorkbook.Sheets("Master List").Range("A2:AZ2000"), 12, False)
If IsError(Res) = False Then
Range("W" & i13).Value = Res
Else
Range("W" & i13).Value = "Not Found"
End If
Res = Application.VLookup(Sheets("import").Range("B" & i13).Value, ThisWorkbook.Sheets("Master List").Range("A2:AZ2000"), 13, False)
If IsError(Res) = False Then
Range("X" & i13).Value = Res
Else
Range("X" & i13).Value = "Not Found"
End If
Next i13
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'CLEANING UP IMPORTED DATA
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Delete /U, /M and /X from
Sheets("import").Range("F2:F" & Row_Count).Select
Selection.Replace What:="/U", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="/X", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="/M", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' Sheets("import").Range("K2:K" & Row_Count).Select
' Selection.Replace What:="/U", Replacement:="", LookAt:=xlPart, _
' SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
' ReplaceFormat:=False
' Selection.Replace What:="/X", Replacement:="", LookAt:=xlPart, _
' SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
' ReplaceFormat:=False
' Selection.Replace What:="/M", Replacement:="", LookAt:=xlPart, _
' SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
' ReplaceFormat:=False
'Paste special values everything to verify no formulas
Range("A2:AZ" & Row_Count).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'AutoFit All
Columns("A:AZ").Select
Columns("A:AZ").EntireColumn.AutoFit
'Replacing Problematic Characters
Cells.Replace What:=",", Replacement:="-", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="#Value!", Replacement:="0", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="#Name?", Replacement:="0", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="#N/A", Replacement:="Empty", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="""", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Customer Tag Number -", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'CHAPTER 3: REMOVING INVALID BUILDS
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Removing builds without a name (Zone 3)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim r3 As Integer
Dim n As Integer
n = 1
Sheets("import").Select
Row_Count = Count_Rows(Row_Count)
If CheckBox1 = True Then
For r3 = Row_Count To 2 Step -1
If Cells(r3, 1) = "-" Then
n = n + 1
Rows(r3).Cut
Sheets("Sheet2").Select
Range("A" & n).Select
ActiveSheet.Paste
Range("A" & n).Select
With Selection.Interior
.Color = 255
End With
Sheets("import").Select
End If
Next r3
End If
'Delete empty cells for 2nd time (zone 4)
Sheets("import").Select
Delete_Rows (Row_Count)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Removing builds on credit hold (zone 5)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim r5 As Integer
Sheets("import").Select
Row_Count = Count_Rows(Row_Count)
If CheckBox2 = True Then
For r5 = Row_Count To 2 Step -1
If Cells(r5, 10) = "ON HOLD" Then
n = n + 1
Rows(r5).Cut
Sheets("Sheet2").Select
Range("A" & n).Select
ActiveSheet.Paste
Range("J" & n).Select
With Selection.Interior
.Color = 255
End With
Sheets("import").Select
End If
Next r5
End If
'Delete empty cells for 3rd time (zone 6)
Sheets("import").Select
Delete_Rows (Row_Count)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Removing jobs not on master list (zone 7)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim r7 As Integer
Sheets("import").Select
Row_Count = Count_Rows(Row_Count)
If CheckBox3 = True Then
For r7 = Row_Count To 2 Step -1
If Cells(r7, 12) = "Not Found" Then
n = n + 1
Rows(r7).Cut
Sheets("Sheet2").Select
Range("A" & n).Select
ActiveSheet.Paste
Range("L" & n).Select
With Selection.Interior
.Color = 255
End With
Sheets("import").Select
End If
Next r7
End If
'Delete empty cells for 4th time (zone 8)
Sheets("import").Select
Delete_Rows (Row_Count)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Removing jobs with QTY = 0 (zone 14)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim r14 As Integer
Sheets("import").Select
Row_Count = Count_Rows(Row_Count)
If CheckBox5 = True Then
For r14 = Row_Count To 2 Step -1
If Cells(r14, 3) = "0" Then
n = n + 1
Rows(r14).Cut
Sheets("Sheet2").Select
Range("A" & n).Select
ActiveSheet.Paste
Range("C" & n).Select
With Selection.Interior
.Color = 255
End With
Sheets("import").Select
End If
Next r14
End If
'Delete empty cells for 4th time (zone 15)
Sheets("import").Select
Delete_Rows (Row_Count)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Removing already run jobs from import (zone 9)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Figuring out how long "sheet3" is
'(*will not read correctly is empty cells in colomn A still exist)
Dim n9 As Integer
Dim p9 As Integer
Dim Run_Jobs_Rows
ThisWorkbook.Sheets("Run Jobs").Select
Run_Jobs_Rows = Count_Rows(Row_Count)
Sheets("import").Select
Row_Count = Count_Rows(Row_Count)


'donefiguringout
Dim i9 As Integer
Dim j9 As Integer
For i9 = Run_Jobs_Rows To 2 Step -1
For j9 = Row_Count To 2 Step -1
If Sheets("import").Cells(j9, 1).Value = ThisWorkbook.Sheets("Run Jobs").Cells(i9, 1).Value Then
n = n + 1
Sheets("import").Cells(j9, 1).EntireRow.Cut
Sheets("Sheet2").Select
Range("A" & n).Select
ActiveSheet.Paste
Range("A" & n).Select
With Selection.Interior
.Color = 255
End With
j9 = j9 - 1
End If
Next j9
Next i9
'Delete empty cells for 5th time (zone 10)
Sheets("import").Select
Delete_Rows (Row_Count)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Removing Jobs older than date (zone 16)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Delete_Date As Date
Dim r16 As Integer
Sheets("import").Select
Row_Count = Count_Rows(Row_Count)
If CheckBox4 = True Then
Delete_Date = MonthView1.Value
For r16 = Row_Count To 2 Step -1
If Range("E" & r16).Value < Delete_Date Then
n = n + 1
Rows(r16).Cut
Sheets("Sheet2").Select
Range("A" & n).Select
ActiveSheet.Paste
Range("E" & n).Select
With Selection.Interior
.Color = 255
End With
Sheets("import").Select
End If
' MsgBox (Range("E" & r16).Value)
Next r16
End If
'Delete empty cells for 3rd time (zone 17)
Sheets("import").Select
Delete_Rows (Row_Count)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Copy "import" over to "Run Jobs" (zone 11)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 'Turn Runs Jobs Grey first
' ProgressBar1.Value = 80
' Columns("A:A").Select
' With Selection.Interior
' .Pattern = xlSolid
' .PatternColorIndex = xlAutomatic
' .ThemeColor = xlThemeColorDark1
' .TintAndShade = -0.149998474074526
' .PatternTintAndShade = 0
' End With
Dim n10 As Integer
Dim p10 As Integer
n10 = 2
For p10 = 2 To 5000
If Sheets("import").Range("C" & p10) = "" Then
p10 = 5000
Else
n10 = n10 + 1
End If
Next p10
n10 = n10 - 1
Row_Count10 = n10
If Row_Count10 = "0" Then
Range("A1").Select
Else
Sheets("import").Range("A2:AZ" & Row_Count10).Select
Application.CutCopyMode = False
Selection.Copy
ThisWorkbook.Sheets("Run Jobs").Rows("2:2").Insert Shift:=xlDown
Range("A2").Select
End If
'CHAPTER 4: JIT Sheet
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Create a sheet 4(JIT) (zone 12)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ProgressBar1.Value = 90
ThisWorkbook.Sheets("Jit Sheet").Cells.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Cells.Select
ActiveSheet.Paste
ActiveSheet.Name = "Jit Sheet"
Row_Count = Count_Rows(Row_Count)
Dim j12 As Integer
Dim n12 As Integer
n12 = 2
j12 = Row_Count
For n12 = 151 To 2 Step -1
For j12 = Row_Count To 2 Step -1
If Sheets("import").Cells(j12, 15).Value = Sheets("Jit Sheet").Cells(n12, 1).Value Then
ActiveWorkbook.Sheets("Jit Sheet").Cells(n12, 2).Value = ActiveWorkbook.Sheets("Jit Sheet").Cells(n12, 2).Value + ActiveWorkbook.Sheets("import").Cells(j12, 3).Value
End If
Next j12
Next n12
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Send an Email
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ProgressBar1.Value = 100
' ProgressBar1.Hide
If CheckBox6 = True Then
Sheets("Jit Sheet").Select
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim i As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2010
'We exit the sub when your answer is NO in the security dialog that you only
'see when you copy a sheet from a xlsm file with macro's disabled.
If Sourcewb.Name = .Name Then
With Application
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
' Exit Function
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With
' 'Change all cells in the worksheet to values if you want
' 'With Destwb.Sheets(1).UsedRange
' '.Cells.Copy
' '.Cells.PasteSpecial xlPasteValues
' '.Cells(1).Select
' 'End With
' 'Application.CutCopyMode = False
' 'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
For i = 1 To 3
.SendMail "", _
"Restock PTL Low Running Valves"
If Err.Number = 0 Then Exit For
Next i
On Error GoTo 0
.Close SaveChanges:=False
End With
'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr
With Application
' .ScreenUpdating = True
.EnableEvents = True
End With
End If
'CHAPTER 5: CLOSING HOUSE KEEPING
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'MISC HOUSE KEEPING
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Add Heading to Sheet 2 and 4
Sheets("import").Rows(1).Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
'Rename and autofit Sheets 2, 3, and 4
Sheets("sheet2").Name = "removed jobs"
Columns("A:AZ").Select
Columns("A:AZ").EntireColumn.AutoFit
Sheets("sheet3").Name = "original file"
Columns("A:AZ").Select
Columns("A:AZ").EntireColumn.AutoFit
Sheets("Jit Sheet").Select
Columns("A:AZ").Select
Columns("A:AZ").EntireColumn.AutoFit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Sort the ending "import" sheet
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If ComboBox1 = "Name" Then
Cells.Select
Worksheets("import").Sort.SortFields.Clear
Worksheets("import").Sort.SortFields.Add Key:=Range("A2:A136") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Worksheets("import").Sort
.SetRange Range("A1:AZ136")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
If ComboBox1 = "OS" Then
Cells.Select
Worksheets("import").Sort.SortFields.Clear
Worksheets("import").Sort.SortFields.Add Key:=Range("B2:B136") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Worksheets("import").Sort
.SetRange Range("A1:AZ136")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
If ComboBox1 = Date Then
Cells.Select
Worksheets("import").Sort.SortFields.Clear
Worksheets("import").Sort.SortFields.Add Key:=Range("E2:E136") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Worksheets("import").Sort
.SetRange Range("A1:AZ136")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
'Select ending cells
Sheets("Jit Sheet").Select
Sheets("Jit Sheet").Range("A1").Copy
Sheets("Jit Sheet").Range("A1").Select
Sheets("original file").Select
Sheets("original file").Range("A1").Select
Sheets("removed jobs").Select
Sheets("removed jobs").Range("A1").Select
Sheets("import").Select
Sheets("import").Range("A1").Select
'Display a ending message
MsgBox "The file has been converted" & vbCrLf & _
"Number of invalid rows deleted: " & n _
, vbInformation + vbOKOnly, "Macro finished"
'Next zone is now 18
Application.ScreenUpdating = True
ActiveWorkbook.Save
ThisWorkbook.Save
End Sub


'Private Sub Calendar1_Click(ByVal DateClicked As Date)
' On Error Resume Next
' Dim Delete_Date As Date
' Delete_Date = DateClicked
'End Sub


Private Sub CommandButton2_Click()
Unload Me
End Sub




Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
Dim Delete_Date As Date
Delete_Date = DateClicked
End Sub



'Functions contained in another Module
Function Count_Rows(Row_Count As Integer) As Integer
Row_Count = 1
Do While Range("A" & Row_Count) <> ""
Row_Count = Row_Count + 1
Loop
Row_Count = Row_Count - 1
Count_Rows = Row_Count
End Function


Function Delete_Rows(ByVal Row_Count As Integer)
Dim i As Long
i = 0
For i = Row_Count To 2 Step -1
Sheets("import").Select
If Cells(i, 1) = "" Then Rows(i).Delete
Next i
End Function

 

[Norie]

Instead of using ActiveWorkbook create a reference to the new workbook when you add it.

Set wbNew = Workbooks.Add

You can now use wbNew whenever you want to refer to this workbook.

In the code you should try and get rid of all the Selects and add workbook/worksheet references for all the ranges.

Also replace ActiveSheet with an explicit worksheet reference.