My Workbook won't save

**jomili** · 07-28-2017, 03:39 PM

I have a long set of macros, posted at very bottom. Directly below here is the truncated version, and my issue is with the line in red. My issue is that it DOES save in the new folder (2nd save), but the original WB doesn't save (1st save), and I can't figure out why.

Sub Proj_HarvestExp()
    Dim PT As PivotTable
    Dim WbSrc As Workbook
    Dim MopMos As Workbook
    Dim Lastrow As Long
    Dim Rng As Range
    Dim Ws As Worksheet
    
    Set MopMos = Workbooks.Open _
    ("\\12AUST1001FS01\SHARE10011\Budget\SOBUDGET\CPS\Jomili\Templates\Consolidated Expense Calcs Template.xlsx", ReadOnly:=False, UpdateLinks:=True)
    
     ‘Gather various expenses
    
        
    MopMos.Save

    MopMos.SaveAs FileName:="\\12AUST1001FS01\SHARE10011\Budget\SOBUDGET\Foster Care & Adoption\Projections\CY 20" & cy & "\20" & cy & " " & mo & " Projection\Projection Docs\Consolidated DFPS Expense Calcs.xlsx", FileFormat:=51
    MopMos.Close False    
    
End Sub

Sub Proj_HarvestExp()
    Dim PT As PivotTable
    Dim WbSrc As Workbook
    Dim MopMos As Workbook
    Dim Lastrow As Long
    Dim Rng As Range
    Dim Ws As Worksheet
    
    'On Error GoTo ResetSpeed
    SpeedOn
    
    Set MopMos = Workbooks.Open _
    ("\\12AUST1001FS01\SHARE10011\Budget\SOBUDGET\CPS\John\Templates\Consolidated DFPS Expense Calcs Template.xlsx", ReadOnly:=False, UpdateLinks:=True)
    
    MopMos.Sheets.Add().Name = "WorkPage"
    
    'FY14 expenses
    Set WbSrc = Workbooks.Open("\\12aust1001fs01\SHARE10011\Budget\SOBUDGET\_Protected_Data\Source_Docs\_OOE_MOF_PivotTables\OOE_BR14_ExpDtl_FCAdopt.xlsm", ReadOnly:=True, UpdateLinks:=True)
     Filter_Pivot

    Set PT = ActiveSheet.PivotTables(1)

    PT.TableRange1.Offset(1, 0).Resize(PT.TableRange1.Rows.Count - 1, PT.TableRange1.Columns.Count).Copy MopMos.Sheets("WorkPage").Range("A1")

    WbSrc.Close False
    
    'FY15 expenses
    Set WbSrc = Workbooks.Open("\\12aust1001fs01\SHARE10011\Budget\SOBUDGET\_Protected_Data\Source_Docs\_OOE_MOF_PivotTables\OOE_BR15_ExpDtl_FCAdopt_New.xlsm", ReadOnly:=True, UpdateLinks:=True)
    Filter_Pivot

    Set PT = ActiveSheet.PivotTables(1)
    PT.TableRange1.Offset(2, 0).Resize(PT.TableRange1.Rows.Count - 2, PT.TableRange1.Columns.Count).Copy

    MopMos.Sheets("WorkPage").Activate

    With ActiveSheet
        Lastrow = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
        .Range("A" & Lastrow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    End With

    WbSrc.Close False
    
    'FY16/17 expenses
    Set WbSrc = Workbooks.Open("\\12aust1001fs01\SHARE10011\Budget\SOBUDGET\_Protected_Data\Source_Docs\_OOE_MOF_PivotTables\OOE_BR1617_ExpDtl_FCAdopt_New.xlsm", ReadOnly:=True, UpdateLinks:=True)
    Filter_Pivot
   
    Set PT = ActiveSheet.PivotTables(1)
    PT.TableRange1.Offset(2, 0).Resize(PT.TableRange1.Rows.Count - 2, PT.TableRange1.Columns.Count).Copy
    
    With MopMos
        .Sheets("WorkPage").Activate
       With ActiveSheet
           Lastrow = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
           .Range("A" & Lastrow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
           :=False, Transpose:=False
           Application.CutCopyMode = False
    
           WbSrc.Close False
           Set WbSrc = Nothing
        
           'Determine our new last row
           Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
                      
           'Create our new FY and Accounting Period columns
           .Columns("F:G").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
           .Range("F1").FormulaR1C1 = "FY"
           .Range("F2:F" & Lastrow).FormulaR1C1 = "=LEFT(RC[2],4)"
           .Range("G1").FormulaR1C1 = "Accounting Period"
           .Range("G2:G" & Lastrow).FormulaR1C1 = "=RIGHT(RC[1],2)"
           .Calculate
           
           With .Range("F2:G" & Lastrow)
               .Value = .Value
           End With
           
           'Move Expense
           .Columns("L").Cut
           .Columns("I").Insert Shift:=xlToRight
           .Range("I1").Value = "MONETARY_AMOUNT"
           
           'Add a Gr/Tanf column for PAC 29200
           .Columns("M:M").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
           .Range("M1").FormulaR1C1 = "GR/TANF"
           
           .Rows(1).AutoFilter Field:=12, Criteria1:="29200"
               .Rows(1).AutoFilter Field:=2, _
               Criteria1:=Array("Rel Caregiver Flexible Support", "Rel Caregiver Integration Pmt", "Relative Caregiver Payment", "Rel-Integr-Sibling Add - on"), Operator:=xlFilterValues
               .Range("M2:M" & Lastrow).SpecialCells(xlCellTypeVisible).Value = "TANF"
               .Rows(1).AutoFilter Field:=2
           .Rows(1).AutoFilter Field:=13, Criteria1:=""
           .Range("M2:M" & Lastrow).SpecialCells(xlCellTypeVisible).Value = "GR"
           .AutoFilterMode = False
           
           'Set up our IVE's, EAs, Svc, and Facility columns
           .Range("N1").FormulaR1C1 = "Ive/NonIVE"
           .Range("N2:N" & Lastrow).FormulaR1C1 = "=VLOOKUP(RC[-2],Lookups!R1C11:R18C12,2,FALSE)"
           .Range("O1").FormulaR1C1 = "EA"
           .Range("O2:O" & Lastrow).FormulaR1C1 = "=IFERROR(IF(VLOOKUP(RC[-14],Lookups!C[-10]:C[-6],3,FALSE)=R1C,WorkPage!RC[-6],0),0)"
           .Range("P1").FormulaR1C1 = "Non-EA"
           .Range("P2:P" & Lastrow).FormulaR1C1 = "=IFERROR(IF(VLOOKUP(RC[-15],Lookups!C[-11]:C[-7],3,FALSE)=R1C,WorkPage!RC[-7],0),0)"
           .Range("Q1").FormulaR1C1 = "Service"
           .Range("Q2:Q" & Lastrow).FormulaR1C1 = "=IFERROR(VLOOKUP(RC1,Lookups!C5:C9,4,FALSE),"""")"
           .Range("R1").FormulaR1C1 = "Facility"
           .Range("R2:R" & Lastrow).FormulaR1C1 = "=IF(OR(RC[-6]=""26300"",RC[-6]=""26400""),IFERROR(VLOOKUP(RC1,Lookups!R78C5:R105C9,5,FALSE),""""),IFERROR(VLOOKUP(RC1,Lookups!C5:C9,5,FALSE),""""))"
           
           'Make our PAC a consistent name
           .Range("L1").Value = "PROGRAM_CODE"
           'Add the time the expenses were pulled
           .Range("S1").FormulaR1C1 = "Expenses Pulled"
           .Range("S2").Value = Now
           .Columns.AutoFit
           .Calculate
       End With
    
    ProjForm1.Show

        With ActiveSheet
            'Determine our last row
            Lastrow = .Range("C" & Rows.Count).End(xlUp).Row
            cy = .Range("A" & Lastrow).Offset(1, 19).Value
            mo = .Range("A" & Lastrow).Offset(2, 19).Value
            'MsgBox cy & " " & mo
            
           .Columns("T:U").Delete
        End With
        ResetUsedRange
    
        'Wipe the old Source table
        With .Sheets("Source")
            With .ListObjects("Table1")
                If Not .DataBodyRange Is Nothing Then
                    .DataBodyRange.Delete
                End If
                .Unlist
            End With
        End With
    
        .Sheets("WorkPage").Activate
        With ActiveSheet
            Set Rng = RealUsedRange
            Rng.Copy
        End With
    
        'Restore our Source sheet to it's former glory
        .Sheets("Source").Activate
        With ActiveSheet
            .Range("A1").PasteSpecial xlPasteValues
            .ListObjects.Add(xlSrcRange, .UsedRange, , xlYes).Name = "Table1"
            .ListObjects("Table1").TableStyle = "TableStyleLight16"
            .UsedRange.Columns.AutoFit
        End With
        
        'Make sure our pivots are looking at the new table we just made
        For Each Ws In MopMos.Worksheets
            For Each PT In Ws.PivotTables
              PT.ChangePivotCache _
                MopMos.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Table1")
            Next PT
        Next Ws
            
        .Sheets("WorkPage").Delete
        
        With .Sheets("PAC 292 TANF")
            .Range("C3:C14").FormulaR1C1 = "=IF(COUNTIF(RC[-1],""Total""),SUM(R[-2]C:R[-1]C),SUMIFS(Table1[MONETARY_AMOUNT],Table1[FY],RC[-2],Table1[GR/TANF],RC[-1]))"
            .Calculate
        End With
        With .Sheets("Manual Payments")
            .Range("C4:H6").FormulaR1C1 = "=SUMIFS(Table1[MONETARY_AMOUNT],Table1[ACCOUNT],RC1,Table1[BUDGET_REF],R3C)"
            .Calculate
        End With
        .RefreshAll
    End With
    
    MopMos.Save
        'MsgBox "\\12AUST1001FS01\SHARE10011\Budget\SOBUDGET\Foster Care & Adoption\Projections\CY 20" & cy & "\20" & cy & " " & mo & " 1 Projection\JL Docs\Consolidated DFPS Expense Calcs.xlsx"
    MopMos.SaveAs FileName:="\\12AUST1001FS01\SHARE10011\Budget\SOBUDGET\Foster Care & Adoption\Projections\CY 20" & cy & "\20" & cy & " " & mo & " Projection\Projection Docs\Consolidated DFPS Expense Calcs.xlsx", FileFormat:=51
    MopMos.Close False
    
    SpeedOff
    Exit Sub
    
ResetSpeed:
    SpeedOff
    MsgBox "We hit an Error." & vbCrLf & vbCrLf & _
    "Please try again later.", vbOKOnly + vbInformation, "Unknown Error"
    Exit Sub
End Sub
Sub Filter_Pivot()
    Dim PF As PivotField
    Dim PI As PivotItem
    Dim PT As PivotTable
    Set PT = ActiveSheet.PivotTables(1)
 
    With PT
        .ManualUpdate = True
        .ClearAllFilters
        On Error GoTo Bailout
        '.PivotCache.Refresh
        On Error GoTo 0
        'Set up our fields
        
        With .PivotFields("ACCOUNT")
            .Orientation = xlRowField
            .Position = 1
            For Each PI In .PivotItems
                If PI = "780600" Then   'Turn off Late Payments
                PI.Visible = False
                Else
                PI.Visible = True
                End If
            Next PI
        End With
        With .PivotFields("ACCT_DESCR")
            .Orientation = xlRowField
            .Position = 2
        End With
        With .PivotFields("BUDGET_REF")
            .Orientation = xlRowField
            .Position = 3
        End With
        With .PivotFields("CLASS_FLD")
            .Orientation = xlRowField
            .Position = 4
        End With
        With .PivotFields("DEPTID")
            .Orientation = xlRowField
            .Position = 5
        End With
        With .PivotFields("FY_AP")
            .Orientation = xlRowField
            .Position = 6
            For i = 1 To .PivotItems.Count
                If .PivotItems(i).Name Like "*GOB*" Or .PivotItems(i).Name Like "*LAR*" Or .PivotItems(i).Name Like "(blank)" Then
                    .PivotItems(i).Visible = False
                Else
                    .PivotItems(i).Visible = True
                End If
            Next i
        End With
        With .PivotFields("MOP")
            .Orientation = xlRowField
            .Position = 7
        End With
        With .PivotFields("MOS2")
            .Orientation = xlRowField
            .Position = 8
            For Each PI In .PivotItems
                Select Case PI.Name
                    Case "09", "10", "11", "12", "01", "02", "03", "04", "05", "06", "07", "08"
                    Case Else
                    PI.Visible = False
                End Select
            Next PI
        End With
        Set PF = GetPACField(PT)
        If Not PF Is Nothing Then
        With PF
            On Error Resume Next
            .Orientation = xlRowField
            .Position = 9
            For Each PI In .PivotItems
                Select Case PI.Name
                    Case "26000", "26100", "26200", "26300", "263SE", "26400", "26500", "26600", _
                    "26900", "27100", "27400", "28000", "28100", "29200", "29300", "29400", "29500"
                    Case Else
                    PI.Visible = False
                End Select
            Next PI
            On Error GoTo 0
        End With
        End If
        With .PivotFields("DATA_TYPE")
            .Orientation = xlPageField
            .Position = 1
            For Each PI In .PivotItems
                If PI = "EXPENSE" Then
                    PI.Visible = True
                Else
                    PI.Visible = False
                End If
            Next
        End With
        On Error Resume Next
        With .PivotFields("CP_PAC")
            .Orientation = xlPageField
            .Position = 1
        End With
        On Error GoTo 0
        
        Set PF = GetBudAcctField(PT)
        If Not PF Is Nothing Then
        With PF
            .Orientation = xlPageField
            .Position = 5
        End With
        End If
        With .PivotFields("STRATEGY")
            .Orientation = xlPageField
            .Position = 5
        End With
        
              'Turn off subtotals
        ActiveSheet.Range("A5").Select
        Application.CommandBars.ExecuteMso "PivotTableSubtotalsDoNotShow"
        
        'Trusty Code below fails, not sure why.  Above is a make do.
'        For Each PF In .PivotFields
'            'Set index 1 (Automatic) to True,
'            'so all other values are set to False
'            PF.Subtotals(1) = True
'            PF.Subtotals(1) = False
'        Next PF
    
        .ColumnGrand = False
        .RowGrand = False
        .RepeatAllLabels xlRepeatLabels
        .ManualUpdate = False
        
  
   
    End With
    Exit Sub
Bailout:
MsgBox "The Open Year Summary can't be refreshed right now." & vbCrLf & vbCrLf & _
"Please try again later.", vbOKOnly + vbInformation, "QA Team Updating File"
WbSrc.Close False
SpeedOff
Exit Sub
End Sub

**jomili** · 07-28-2017, 04:05 PM

Sometimes my native stupidity astounds me. I found the problem; I was opening a workbook from the wrong folder, so it was saving to the wrong folder. Duh! Sorry.

My Workbook won't save

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

My Workbook won't save

Re: My Workbook won't save

Thread Information

Users Browsing this Thread

Similar Threads

Save worksheet as workbook but with 'save as' feature

Save the current worrkbook, save the sheet as .csv and close the workbook

[SOLVED] Multiple workbooks into one workbook - asked to save or not save each workbook step remove

Make Workbook Read Only and not allowed to Save and Save As

Incremental save. Save just one worksheet of a workbook?

Save workbook using variable for save as and for a new folder name

[SOLVED] IMPLEMENT > SAVE AS < ON A WORKSHEET AND SAVE IT IN ANOTHER WORKBOOK.

Bookmarks

Bookmarks

Posting Permissions