SaveAs failing despite not changing the code - excel

Question

I have a function in a larger macro that helps reformat and clean up some data from a specific measurement file so that it can be used by the rest of the macro. I recently needed to update some of the data clean-up & reformatting that the function does based on guidance from the department that uses the macro. Those changes work fine, but now the .SaveAs is failing on Error 1004 "SaveAs method of object '_Workbook' failed".
I compared the old & new versions in a text comparison program (UltraCompare) and the changes definitely shouldn't impact the SaveAs. If I stop the macro at the point just before SaveAs and manually save that works successfully, so nothing in the file itself is blocking the save, nor is it a permissions change I didn't know about (which is extra not likely since the test folder is a child of my Desktop).
To go through some of the answers I've seen to other questions on this error
I don't use ActiveWorkbook to save, I create the workbook when setting a workbook variable
I don't use a date in the save as file name
There are no hyperlinks in the workbook
Excel doesn't throw a prompt, and alerts are left on prior to the SaveAs line
As mentioned above, the save is to a folder off my Desktop, so network drive mapping involved
Some additional things I've tried:
During debug, creating a new variable immediately prior to the .SaveAs line & populating it with a new file name in the same folder, and using that in the .SaveAs in place of the replace
Again with a new variable prior to .SaveAs that specifies a different folder
Specifying FileFormat:=51
All that said, here's the code, if anyone has ideas I'm game:
Function MergeCDC(sw As StatWin, fpath As String, BadDateRef As Range, Optional FromComb As Boolean = False) As Boolean
'StatWin is a custom form with a text box for printing status text to the user & a progress bar. fpath is the full file path of the file to be used as a string (folder path & file name including file extension)
'BadDateRef is a cell in the workbook that holds this function that holds the date 1/1/1900 which is used by the file being processed to indicate no date (i.e. the field should be null, but the DBAs
'decided to be weird so we have to deal with it)
'FromComb is a way to know if this function was called by a specific other function, so that run time tracking can be handled correctly
'Check if we're blocked on CDC (this prevents the function from trying to run again if it's called a second (or greater) time after failing)
If sw.CDCBlock Then
MergeCDC = False
Exit Function
End If 'else continue
Dim src As Workbook
Set src = Workbooks.Open(fpath) 'No need to check if the CDC workbook is present as that was done prior to this function being invoked
Dim ry As Worksheet
Dim ytd As Worksheet
Dim m As Workbook
Set m = Workbooks.Add
Dim ms As Worksheet
Set ms = m.Worksheets(1)
Dim ret As Boolean
ret = False
Dim c As Long
Dim r As Long
Dim ryc As Long
Dim temp() As Long
Dim msc As Long
Dim z As Integer
Dim yfnd As Boolean
Dim rfnd As Boolean
'Update the RunStat sheet such that we track CDC data merge as it's own item
If FromComb Then
sw.RStat.Range("A" & sw.StatRow + 2).Value = sw.RStat.Range("A" & sw.StatRow + 1).Value
sw.RStat.Range("B" & sw.StatRow + 2).Value = sw.RStat.Range("B" & sw.StatRow + 1).Value 'Bump start time for combined list being created
sw.RStat.Range("A" & sw.StatRow + 1).Value = sw.RStat.Range("A" & sw.StatRow).Value 'bump start for creation of combined source file
sw.RStat.Range("B" & sw.StatRow + 1).Value = sw.RStat.Range("B" & sw.StatRow).Value
Else
sw.RStat.Range("A" & sw.StatRow + 1).Value = sw.RStat.Range("A" & sw.StatRow).Value 'bump start for creation of CDC list
sw.RStat.Range("B" & sw.StatRow + 1).Value = sw.RStat.Range("B" & sw.StatRow).Value
End If
sw.RStat.Range("A" & sw.StatRow).Value = "CDC Merge"
sw.RStat.Range("B" & sw.StatRow).Value = Now()
'Determine which sheet is which
z = 1
yfnd = True
rfnd = True
Do While z <= src.Worksheets.Count And (yfnd Or rfnd)
If InStr(1, UCase(src.Worksheets(z).Name), "YTD") > 0 Then
yfnd = False
Set ytd = src.Worksheets(z)
ElseIf InStr(1, UCase(src.Worksheets(z).Name), "RY") > 0 Then
rfnd = False
Set ry = src.Worksheets(z)
End If
z = z + 1
Loop
'Check we found both sheets
If rfnd Or yfnd Then
Call Err("Unable to locate the RY and/or YTD worksheets in the Unedited CDC file. Please update the file such that the YTD worksheet includes 'YTD' in its name, and the RY" _
& " worksheet includes 'RY' in its name. This error prevents any list utilizing CDC data from being completed.", sw)
MergeCDC = False
sw.CDCBlock = True
Exit Function
End If 'else continue as normal
'Prep the two worksheets
temp = CDCPrep(ry, True, sw)
ryc = temp(0)
r = temp(1) 'CDCPrep returns the first BLANK row so we will use r as the row to paste to when pasting YTD data
'Prep of RY successful?
If temp(0) <> -1 Then
temp = CDCPrep(ytd, False, sw)
Else
'Close the new workbook without saving
m.Close SaveChanges:=False
End If
'Continue?
If temp(0) <> -1 Then
'Copy the entirety of Rolling Year data
ry.Range("A1:" & ColNumToStr(ryc) & r - 1).Copy
ms.Range("A1").PasteSpecial xlPasteAll
'Start merging in the YTD data. Since we can't assume the columns are in the same order we'll start iterating through the RY columns and copying one column at a time from YTD
c = 0
Do While ms.Range("A1").Offset(0, c).Value <> ""
'Find the matching column in YTD
msc = 0
Dim fnd As Boolean
fnd = False
Do While ytd.Range("A1").Offset(0, msc).Value <> "" And fnd = False
If ytd.Range("A1").Offset(0, msc).Value = ms.Range("A1").Offset(0, c).Value Then
'Found the column. Copy it's data
fnd = True
ytd.Range(ColNumToStr(msc + 1) & "2:" & ColNumToStr(msc + 1) & temp(1)).Copy
Else
msc = msc + 1
End If
Loop
'Did we find a match?
If fnd Then
'Paste the data
ms.Range("A" & r).Offset(0, c).PasteSpecial xlPasteAll
Else
Call Err("Unable to locate the " & ms.Range("A1").Offset(0, c).Value & " column in the Yr To Date data. The list will be generated, but will be missing these values for items found only" _
& " in the Yr To Date data.", sw)
End If
c = c + 1
Loop
'Get the last row of data so we can sort the merged data
r = r + temp(1)
'Check that is the last row
Do While ms.Range("A" & r).Value <> "" And r < 600000 'ridiculously high value, but serves as a fail-safe to keep from hitting end of sheet and not having found data end
r = r + 1
Loop
'Sort the data and remove duplicates according to the current month (Jan - Jun: RY rows preferred to YTD; Jul - Dec: YTD preferred)
If Month(sw.CurDate) < 7 Then
'RY preferred
ms.Sort.SortFields.Clear
ms.Sort.SortFields.Add Key:=Range _
("A2:A" & r), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ms.Sort.SortFields.Add Key:=Range _
("B2:B" & r), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ms.Sort
.SetRange Range("A1:" & ColNumToStr(c + 1) & r + temp(1))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Else
'YTD preferred
ms.Sort.SortFields.Clear
ms.Sort.SortFields.Add Key:=Range _
("A2:A" & r), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ms.Sort.SortFields.Add Key:=Range _
("B2:B" & r), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ms.Sort
.SetRange Range("A1:" & ColNumToStr(c + 1) & r + temp(1))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
ms.Range("A1:" & ColNumToStr(c + 1) & r + temp(1)).RemoveDuplicates Columns:=1, Header:=xlYes
'Delete the MergeKey & Source columns
ms.Range("A:B").Delete Shift:=xlLeft
'In order to be processed correctly by other functions later certain target values (Last Test Date, Last Test Value) need to be inserted as new SubMeasures (i.e. new rows)
Dim i As Long
Dim ik As String
Dim sm As String
Dim nc As String
Dim ltd As String
Dim ltv As String
Dim td As String
i = 0
fnd = True
'To add the rows we need to be able to tell when we're on the first row of data for a particular item. Meaning we need to know the column holding ItemKey
Do While ms.Range("A1").Offset(0, i).Value <> "" And fnd
Select Case LCase(ms.Range("A1").Offset(0, i).Value)
Case "itemkey"
mk = ColNumToStr(i + 1)
Case "submeasure"
sm = ColNumToStr(i + 1)
Case "numercnt"
nc = ColNumToStr(i + 1)
Case "date1"
ltd = ColNumToStr(i + 1)
Case "last_val"
ltv = ColNumToStr(i + 1)
Case "terminationdate"
td = ColNumToStr(i + 1)
End Select
i = i + 1
If sm <> "" And ik <> "" And td <> "" And ltd <> "" And nc <> "" And ltv <> "" Then
fnd = False
End If
Loop
If fnd Then
'Couldn't find the needed columns. Report the error
Call Err("Unable to locate the one or more of the following columns in the MergedCDC file: ItemKey, SubMeasure, NumerCnt, TerminationDate, Last Test Date, Last Test Value. This will prevent adding" _
& " rows for Last Test Value & Last Test Date, which will in turn mean those columns will not be correctly populated in any list based on CDC data. All other values from" _
& " the CDC data should be correct though.", sw)
Else
'Add the rows
Dim PM As String
i = 2
Do While ms.Range(mk & i).Value <> ""
If InStr(1, PM, "|" & ms.Range(mk & i).Value & "|") = 0 Then
'First row for this item set all Term Date values are set to the MAX Term Date value for the item. Also determine if they're non-compliant on any measure
Dim y As Integer
Dim tdv As Date
Dim ncv As Integer
y = 0
tdv = DateSerial(1900, 1, 1)
ncv = 1 'Start # 1 so that if any row is non-compliant we can change ncv then (as opposed to having to make sure ALL rows are compliant before setting ncv to 1)
Do While ms.Range(mk & i + y).Value = ms.Range(mk & i).Value
If ms.Range(td & i + y).Value > tdv Then
tdv = ms.Range(td & i + y).Value
End If 'else the term date is older than tdv, and we want to standardize to the max term date, so leave tdv alone
If ms.Range(nc & i + y).Value < ncv Then
ncv = 0
ElseIf ms.Range(sm & i + y).Value = "Tested" Then
'Check if the Test Value = 0 and if the Last Test Date is valid
If (ms.Range(ltd & i + y).Value = DateSerial(1900, 1, 1) Or ms.Range(ltd & i + y).Value = "" Or ms.Range(ltd & i + y).Value = BadDateRef.Value) _
And ms.Range(lbg & i + y).Value = 0 Then
'The value is 0 and the date isn't valid, that means the item wasn't actually tested (in effect if not actuality). Set this row to not tested & update ncv
ms.Range(nc & i + y).Value = 0
ncv = 0
End If 'else the item was tested, the compliance value stays the same, which means ncv doesn't need changed
End If 'Else row indicates item is compliant, which is the default, so no action needed
y = y + 1
Loop
'Replace Term Date values that aren't TDV with TDV (technically, we also replace the row that set TDV, but with the same value)
If tdv <> DateSerial(1900, 1, 1) Then
y = 0
Do While ms.Range(mk & i + y).Value = ms.Range(mk & i).Value
ms.Range(td & i + y).Value = tdv
y = y + 1
Loop
Else
'No actual date found for TDV, just clear the cells setting the format to General so that Excel doesn't re-fill in 1/1/1900
y = 0
Do While ms.Range(mk & i + y).Value = ms.Range(mk & i).Value
ms.Range(td & i + y).NumberFormat = "General"
ms.Range(td & i + y).ClearContents
y = y + 1
Loop
End If
'Copy the current row & insert two copies of it below the current row
ms.Range(i & ":" & i).Copy
ms.Range(i + 1 & ":" & i + 1).Insert Shift:=xlDown
ms.Range(i & ":" & i).Copy
ms.Range(i + 1 & ":" & i + 1).Insert Shift:=xlDown
'Change the SubMeasure cells appropriately
ms.Range(sm & i + 1).Value = "Last Test Date"
ms.Range(sm & i + 2).Value = "Last Test Val"
'Set the compliance cnt value. If the item's last value is 0 AND there is no Last Test Date value, the numercnt value for the two added rows should be 0 so that date & value
' appear (as even though they're compliant, they probably shouldn't be marked as such due to lack of proof). If the value is non-0 then set based on ncv
If ms.Range(lbg & i).Value = 0 & ms.Range(ltd & i + y).Value = "" Then
ms.Range(nc & i + 1).Value = 0
ms.Range(nc & i + 2).Value = 0
Else
ms.Range(nc & i + 1).Value = ncv
ms.Range(nc & i + 2).Value = ncv
End If
'Add the item to PM, a delimited string of ItemKeys for processed items that lets us check if we've already seen a row for this item
PM = PM & "|" & ms.Range(mk & i).Value & "|"
'Add 2 to i (this way the additional incrementing of i below results in us looking at row i + 3, which was the row that had been immediately below row i before we added the two new rows)
i = i + 2
End If 'else proceed to the next row, which happens anyway
i = i + 1
Loop
End If
'Clear out compliant rows so that MergedCDC processes through MFPRocessor (a seperate function that we're setting up the CDC data to go through) like any other source file
'(submeasure present = item non-compliant on measure)
i = 2
Do While ms.Range(mk & i).Value <> ""
If ms.Range(nc & i).Value = 1 Then
ms.Range(i & ":" & i).Delete Shift:=xlUp
Else
i = i + 1
End If
Loop
'Remove 1/1/1900 values from Last Test Date & Term Date
i = 2
Do While ms.Range(mk & i).Value <> ""
If ms.Range(ltd & i).Value = "1/1/1900" Or ms.Range(ltd & i).Value = BadDateRef.Value Then
ms.Range(ltd & i).NumberFormat = "General"
ms.Range(ltd & i).ClearContents
End If
If ms.Range(td & i).Value = "1/1/1900" Or ms.Range(td & i).Value = BadDateRef.Value Then
ms.Range(td & i).NumberFormat = "General"
ms.Range(td & i).ClearContents
End If
i = i + 1
Loop
ret = True
'Save the workbook
m.SaveAs (Replace(fpath, "CDC", "MergedCDC")) 'This code HAD worked, despite none of the changes being anything that should impact this line, this line
Application.DisplayAlerts = False
m.Close SaveChanges:=False
Application.DisplayAlerts = True
Else
'Close the new workbook without saving
m.Close SaveChanges:=False
End If
'Close the original CDC workbook
Application.DisplayAlerts = False
src.Close
Application.DisplayAlerts = True
'Capture completion of CDC merge
sw.RStat.Range("C" & sw.StatRow).Value = Now()
sw.StatRow = sw.StatRow + 1
MergeCDC = ret
End Function

Answer 1

If you haven't changed your code then here's a few things to check which could be causing the error:
Workbook object is out of context - ensure that you are using only one instance of Excel, if your data and workbook are in different instances then they wont be able to reach each other. When your code breaks at the error, add the workbook to your watch list to see if it reachable.
Filepath is unreachable - when the code breaks at this error, take the value of Replace(fpath, "CDC", "MergedCDC") without the filename at the end, and paste it into windows explorer and check that it is reachable.