Create Incremental Backups when using Power Query

Edit 16 May 2015: I now know the exact cause and cure for this problem.  See this post here This backup tip is still useful though.
This is a follow up to this post where I talked about Power Query and warned to take frequent backups when editing your Power Query Workbooks.  The issue is that Power Query is a bit flaky, and hence it is well advised to create incremental workbook backups with different file names in case bad things happen.

Anthony Newell kindly posted an idea (and some code) that he used to automate the process of taking incremental backups.  I took his code as inspiration, and then made quite some changes to meet my needs.  I am sharing this new code here for those that want to use it.  It is equally as useful for any workbook that you have invested time in, and you can’t afford to lose.  It doesn’t have to be a Power Query workbook.

What the Code Does

• First it checks if there is a “version sheet” in the active workbook.  If not, it creates this version sheet.  The version sheet contains the current version number and the location of your backups.  You can manually change the default backup location in this sheet (but it always saves this as a sub folder of the original file location).
• It then saves the active workbook with its current name in the current active folder (no version number added yet).  I have done it this way because I don’t want my active workbook file name changing all the time.  What I want is a backup that I can recover later if needed.
• It then saves a copy of the active workbook in the archive folder with the current version number appended on the end.
• It then closes the version with the version number added and reopens the original file so that you are working on the original file without the version number.
• Finally it increments the version number on the version page.

How to Use this Code

Simply copy the code from below into your personal.xlsb workbook.  That way it will always be available as a backup tool for what ever workbook you happen to be working on.  It is then easy to add it to your Quick Access Toolbar so it is always 1 click away (as you can see in the animated gif above).

  
 Sub SaveIncrementalFileVersion()
    Dim FileName As String
    Dim FileStub As String
    Dim FullArchiveFileName As String
    Dim Folder As String
    Dim Archive As String
    Dim FullFilename As String
    Dim VersionNo As Long
    Dim myFound As Boolean
    Dim Sheet As Object
    
    On Error GoTo ErrorHandler
    
    ' Check to see if the version sheet exists already
    For Each Sheet In Sheets
        If Sheet.Name = "Version" Then myFound = True
    Next Sheet
    
    If myFound = False Then  ' if the version sheet does not exist, then create it
        Sheets.Add
        ActiveSheet.Name = "Version"
        Range("A1") = "Version Number"
        Range("A2") = "Archive Sub Folder Name"
        Range("b1") = 1
        Range("b2") = "Archive"
        Range("C2") = "<= Manually Change Sub Folder as Needed"
        Columns("A:C").EntireColumn.AutoFit
    End If
    
    ActiveWorkbook.Save 'save current workbook
    
    'prepare variables
    VersionNo = Sheets("Version").Range("B1").Value
    FileName = ActiveWorkbook.Name
    FileStub = Left(FileName, Len(FileName) - 5)
    Folder = ActiveWorkbook.Path
    Archive = Sheets("version").Range("b2").Value
    FullFilename = Folder & "" & FileName
    FullArchiveFileName = Folder & "" & Archive & "" & FileStub & " " & VersionNo
    
    'check if archive folder exists and create it if it doesn't exist
    If Dir(Folder & "" & Archive, vbDirectory) = "" Then
        MkDir ActiveWorkbook.Path & "" & Archive
    End If
    
    ActiveWorkbook.SaveAs FullArchiveFileName 'save as an incremental version number
    ActiveWorkbook.Close savechanges:=False
     
    'reopen the orginal
    Workbooks.Open FileName:=FullFilename
    
    ' increment the version number
    VersionNo = Sheets("Version").Range("B1").Value + 1
    Sheets("Version").Range("B1").Value = VersionNo

    
ErrorExit:
    Exit Sub
    
ErrorHandler:
    Resume ErrorExit
End Sub

Edit 16 May 2015: I now know the exact cause and cure for this problem.  See this post here

If you want a comprehensive lesson on how to use Power Query, checkout my training course here https://exceleratorbi.com.au/power-query-online-training/