Make overdues list.xlsm_Modules_MakeOverduesList.vba

' MakeOverduesList

' New, soon to be properly-formatted, list made from original
Dim newList As String

Const myTemplatesPath = "C:\Users\USERNAME\Documents\Synchronized\_NEW_\"         ' Path to templates
Const reportsPath = "N:\Library\Overdues\"  ' Path to reports
'Const reportsPath = "C:\Users\USERNAME\Desktop\Overdues LOCAL"
Const listTemplate = "Overdues.xlt"         ' Name of template
Const shortcutFilename = "N:\Library\Overdues\Shortcut to current overdues - DO NOT DELETE.lnk" ' Shortcut to current overdues
'Const shortcutFilename = "C:\Users\USERNAME\Desktop\Overdues LOCAL\Shortcut to current overdues - DO NOT DELETE.lnk" ' Shortcut to current overdues
Const homeCell = "A10"                      ' First cell of data
Const dateCell = "A3"                       ' Cell that stores date

' Make new, formatted overdues list from generated one
Public Sub MakeOverduesList(reportPath As String)
    ' Open the report
    Set report = Workbooks.Open(reportPath)
    
    ' Create new workbook from template
    Workbooks.Add Template:=myTemplatesPath & listTemplate
    Range(dateCell).Formula = Now   ' Set date
    
    ' Save, so new workbook will have a name we can refer to
    newList = _
        "Overdues " & Format(Now, Format:="MM-DD-YYYY") & ".xlsx"
    ActiveWorkbook.SaveAs reportsPath & newList
    
    ' Focus original workbook
    report.Activate

    ' Delete first two rows
    Rows("1:2").Select
    Selection.Delete Shift:=xlUp
    
    ' Move columns into place
    ' K -> C
    Columns("K:K").Select
    Selection.Cut
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    ' M -> D
    Columns("M:M").Select
    Selection.Cut
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight
    ' Q -> E
    Columns("Q:Q").Select
    Selection.Cut
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight

    ' Delete contents of columns G through end
    Columns("G:G").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.ClearContents

    ' Strip initial apostrophe from values in A and D
    Columns("A:A").Replace What:="'", Replacement:=""
    Columns("D:D").Replace What:="'", Replacement:=""
    
    ' Select and copy the cells
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Workbooks(newList).Activate ' Switch back to new list
    Range(homeCell).Select      ' Select first cell
    
    'Application.Run "'Personal.xlsb'!PasteFormulas" ' Paste, retaining destination formatting; method is located in Personal.xlsb, module Misc
    Module1.PasteFormulas

    ' Sort list
    SortList

    Range(homeCell).Select ' Unselect range
    ActiveWorkbook.Save ' Resave the report as a regular workbook
    listFilename = ActiveWorkbook.FullName
    
    SaveListAsText      ' Then save as text, for file comparison
    
    ' Close the original report.
    ' Mark it as saved so Excel doesn't prompt us to save it
    report.Saved = True
    report.Close

    ' Sort list again, this time descending by date, so the newest
    ' entries are on top where we can see them easily
    SortListByDateDescending

    Range(homeCell).Select ' Unselect range again
    
    ' Mark it as saved
    ActiveWorkbook.Saved = True
    
    ' TEMP
    'MsgBox "About to recycle report."
    ' Send report to recycle bin
    'Recycle.RecycleSafe reportPath
    ' Note: recycling seems to make the script hang for several seconds. Let's just delete the report.
    ' TEMP
    'MsgBox "About to delete report."
    On Error Resume Next
    Kill (reportPath)
    
    ' TEMP
    'MsgBox "About to delete old shortcut."
    ' Delete old shortcut too (it's on a network drive so it can't be recycled; we wouldn't really want to keep old copies anyway)
    On Error Resume Next
    Kill (shortcutFilename)
    
    ' TEMP
    'MsgBox "About to make new shortcut."
    ' Make new shortcut
    Shortcut.CreateLNKFile shortcutFilename, listFilename
End Sub

' Sort first by patron name, then by material number
Sub SortList()
    Selection.Sort _
        Key1:=Range("Patron_name"), _
        Order1:=xlAscending, DataOption1:=xlSortNormal, _
        Key2:=Range("Copy_ID"), _
        Order2:=xlAscending, DataOption2:=xlSortNormal, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom
End Sub

' Sort by date, descending (most recent on top)
Sub SortListByDateDescending()
        ' Select our range again
        Range(homeCell).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        
        Selection.Sort _
            Key1:=Range("Date_due"), _
            Order1:=xlDescending, DataOption1:=xlSortNormal, _
            Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom
End Sub

Function MyReplace( _
    Expression As String, _
    Find As String, _
    Replace As String) As String

    replacementOffset = InStrRev(Expression, _
        StringMatch:=Find) - 1 ' Find the last occurrence of Find string
    
    firstPart = Left(Expression, replacementOffset)
    MyReplace = firstPart & Replace ' put Replace str on end
End Function

' Save list as text
Sub SaveListAsText()
    textFileName = MyReplace(reportsPath & newList, _
        Find:=".xlsx", Replace:=".txt")
    ActiveWorkbook.SaveAs textFileName, _
        FileFormat:=xlTextWindows, CreateBackup:=False

    ' Mark as saved because Excel will prompt to save it otherwise
    ' (since it's not in an Excel-native format)
    ActiveWorkbook.Saved = True
End Sub