Steve Belsch
04-21-2020, 11:35 AM
VBA Experts,
I could use some ideas. I am getting the above message (in the title box). Here is the code. When it gets to the second instance of this code "ActiveWorkbook.SaveAs Filename:=File_Upload_Temp". This is when I get the error. Not sure why it can't access the file, the code just saved it and not it is trying to save it to the same location?
Any thoughts?
Thanks.
Steve
Sub PO_Oracle_Load_Accruals()
Dim ws As Worksheet
'Set Active Workbook name for ease of toggling between sheets
Dim File_Upload As String
File_Upload = ActiveWorkbook.Name
Dim File_Upload_Temp As String
File_Upload_Temp = "Macroed_Upload_Temp"
'Set Sheet names, EmpID, Initials, etc... as variables
Dim Tab1 As String
Dim Tab2 As String
Dim Tab3 As String
Dim EmpID As Long
Dim Initials As String
Dim MonthYear As String
Windows("PO_Accrual_Upload_Macro.xls").Activate
Sheets("Master_Upload").Select
Cells.Find(What:="Tab 1 to Upload", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
Tab1 = ActiveCell.Value
Cells.Find(What:="Tab 2 to Upload", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
Tab2 = ActiveCell.Value
Cells.Find(What:="Tab 3 to Upload", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
Tab3 = ActiveCell.Value
Cells.Find(What:="Employee Number:", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
EmpID = ActiveCell.Value
Cells.Find(What:="Employee Initials:", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
Initials = ActiveCell.Value
Cells.Find(What:="Month & Year:", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
MonthYear = ActiveCell.Value
'Delete all sheets except PD & Functions
Windows(File_Upload).Activate
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> Tab1 And ws.Name <> Tab2 And ws.Name <> Tab3 Then ws.Delete
Next
'Make Note of the Functions/PD Grand Total Accruals
Dim Tab1_Accrual As Long
Dim Tab2_Accrual As Long
Dim Tab3_Accrual As Long
Dim OrigRC As Integer
Dim RawCost As Integer
Dim GrandTotal As Integer
Sheets(Tab1).Select
Cells.Find(What:="Orig Raw Cost", LookAt:=xlWhole).Activate
OrigRC = ActiveCell.Column
Cells.Find(What:="Current Month Cumulative ETD", LookAt:=xlWhole).EntireColumn.Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Cells.Find(What:="Raw Cost", LookAt:=xlWhole).EntireColumn.Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
RawCost = ActiveCell.Column
Cells.Find(What:="Grand Total", LookAt:=xlWhole).Activate
GrandTotal = ActiveCell.Column
Tab1_Accrual = ActiveCell.Offset(0, (RawCost - GrandTotal)).Value
If Tab2 <> "None" Then
Sheets(Tab2).Select
Cells.Find(What:="Orig Raw Cost", LookAt:=xlWhole).Activate
OrigRC = ActiveCell.Column
Cells.Find(What:="Current Month Cumulative ETD", LookAt:=xlWhole).EntireColumn.Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Cells.Find(What:="Raw Cost", LookAt:=xlWhole).EntireColumn.Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
RawCost = ActiveCell.Column
Cells.Find(What:="Grand Total", LookAt:=xlWhole).Activate
GrandTotal = ActiveCell.Column
Tab2_Accrual = ActiveCell.Offset(0, (RawCost - GrandTotal)).Value
'Put tabs onto one sheet for upload.
Sheets(Tab1).Select
Range("A1").Select
Selection.RemoveSubtotal
ActiveWorkbook.SaveAs Filename:=File_Upload_Temp ...................>>>>>> This is the first instance. it works fine.
Dim Total_Row_Count
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Total_Row_Count = Selection.Rows.Count
Range("A1").Select
For X = 1 To Total_Row_Count
ActiveCell.Offset(1, 0).Select
Next
Sheets(Tab2).Select
Range("A1").Select
Selection.RemoveSubtotal
ActiveWorkbook.SaveAs Filename:=File_Upload_Temp ...................>>>>>> This is the second instance and this is when I get the error message
I could use some ideas. I am getting the above message (in the title box). Here is the code. When it gets to the second instance of this code "ActiveWorkbook.SaveAs Filename:=File_Upload_Temp". This is when I get the error. Not sure why it can't access the file, the code just saved it and not it is trying to save it to the same location?
Any thoughts?
Thanks.
Steve
Sub PO_Oracle_Load_Accruals()
Dim ws As Worksheet
'Set Active Workbook name for ease of toggling between sheets
Dim File_Upload As String
File_Upload = ActiveWorkbook.Name
Dim File_Upload_Temp As String
File_Upload_Temp = "Macroed_Upload_Temp"
'Set Sheet names, EmpID, Initials, etc... as variables
Dim Tab1 As String
Dim Tab2 As String
Dim Tab3 As String
Dim EmpID As Long
Dim Initials As String
Dim MonthYear As String
Windows("PO_Accrual_Upload_Macro.xls").Activate
Sheets("Master_Upload").Select
Cells.Find(What:="Tab 1 to Upload", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
Tab1 = ActiveCell.Value
Cells.Find(What:="Tab 2 to Upload", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
Tab2 = ActiveCell.Value
Cells.Find(What:="Tab 3 to Upload", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
Tab3 = ActiveCell.Value
Cells.Find(What:="Employee Number:", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
EmpID = ActiveCell.Value
Cells.Find(What:="Employee Initials:", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
Initials = ActiveCell.Value
Cells.Find(What:="Month & Year:", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
MonthYear = ActiveCell.Value
'Delete all sheets except PD & Functions
Windows(File_Upload).Activate
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> Tab1 And ws.Name <> Tab2 And ws.Name <> Tab3 Then ws.Delete
Next
'Make Note of the Functions/PD Grand Total Accruals
Dim Tab1_Accrual As Long
Dim Tab2_Accrual As Long
Dim Tab3_Accrual As Long
Dim OrigRC As Integer
Dim RawCost As Integer
Dim GrandTotal As Integer
Sheets(Tab1).Select
Cells.Find(What:="Orig Raw Cost", LookAt:=xlWhole).Activate
OrigRC = ActiveCell.Column
Cells.Find(What:="Current Month Cumulative ETD", LookAt:=xlWhole).EntireColumn.Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Cells.Find(What:="Raw Cost", LookAt:=xlWhole).EntireColumn.Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
RawCost = ActiveCell.Column
Cells.Find(What:="Grand Total", LookAt:=xlWhole).Activate
GrandTotal = ActiveCell.Column
Tab1_Accrual = ActiveCell.Offset(0, (RawCost - GrandTotal)).Value
If Tab2 <> "None" Then
Sheets(Tab2).Select
Cells.Find(What:="Orig Raw Cost", LookAt:=xlWhole).Activate
OrigRC = ActiveCell.Column
Cells.Find(What:="Current Month Cumulative ETD", LookAt:=xlWhole).EntireColumn.Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Cells.Find(What:="Raw Cost", LookAt:=xlWhole).EntireColumn.Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
RawCost = ActiveCell.Column
Cells.Find(What:="Grand Total", LookAt:=xlWhole).Activate
GrandTotal = ActiveCell.Column
Tab2_Accrual = ActiveCell.Offset(0, (RawCost - GrandTotal)).Value
'Put tabs onto one sheet for upload.
Sheets(Tab1).Select
Range("A1").Select
Selection.RemoveSubtotal
ActiveWorkbook.SaveAs Filename:=File_Upload_Temp ...................>>>>>> This is the first instance. it works fine.
Dim Total_Row_Count
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Total_Row_Count = Selection.Rows.Count
Range("A1").Select
For X = 1 To Total_Row_Count
ActiveCell.Offset(1, 0).Select
Next
Sheets(Tab2).Select
Range("A1").Select
Selection.RemoveSubtotal
ActiveWorkbook.SaveAs Filename:=File_Upload_Temp ...................>>>>>> This is the second instance and this is when I get the error message