Initial commit

src/Enumerations.cls

@@ -0,0 +1,66 @@
+' Author: Edward Middleton-Smith
+' Precision And Research Technology Systems Limited
+
+' Project:
+' Technology:
+' Feature:
+
+
+
+' NOTES
+
+
+
+' METHOD LAYOUT COMMENTS
+' FUNCTION
+' ARGUMENTS
+' PROCESSING ACCELERATION
+' CONSTANTS
+' VARIABLE DECLARATION
+' ARGUMENT VALIDATION
+' VARIABLE INSTANTIATION
+' METHODS
+' RETURNS
+' ERROR HANDLING
+' PROCESSING DECELARATION
+
+
+
+' MODULE INITIALISATION
+' Set array start index to 1 to match spreadsheet indices
+Option Base 1
+' Forced Variable Declaration
+Option Explicit
+
+
+' Worksheet orientation
+Enum orientation
+    ColumnHeaders = 0
+    RowHeaders = 1
+End Enum
+
+
+' Array search direction
+Enum direction
+    x = 1
+    y = 2
+    Z = 3
+End Enum
+
+
+' Different search direction
+Enum dir_traverse
+    FORWARDS = 1
+    BACKWARDS = -1
+End Enum
+
+
+' Customer account status
+Enum OverdueStatus
+    UNDUE = 0
+    OVERDUE = 1
+    SUPEROVERDUE = 2
+End Enum
+
+
+

src/Main.bas

@@ -0,0 +1,600 @@
+' Author: Edward Middleton-Smith
+' Precision And Research Technology Systems Limited
+
+
+' MODULE INITIALISATION
+' Set array start index to 1 to match spreadsheet indices
+Option Base 1
+' Forced Variable Declaration
+Option Explicit
+
+' Sleep function
+Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
+
+Sub Main()
+' FUNCTION
+    ' Create database relationship bbetwee different tables of data in worksheets
+' VARIABLE DECLARATION
+    ' Excel
+    Dim wb_me As Workbook
+    Dim wb_cash As Workbook
+    Dim wb_day As Workbook
+    Dim wb_customers As Workbook
+    Dim ws_out As Worksheet
+    Dim ws_anal As Worksheet
+    Dim ws_cash As Worksheet
+    Dim ws_day As Worksheet
+    Dim ws_customers As Worksheet
+    ' Worksheet Container Relation
+    Dim ws_rel As ws_relation
+    ' Worksheet Containers
+    Dim wsc_out As ws_access
+    Dim wsc_cash As ws_access
+    Dim wsc_day As ws_access
+    Dim wsc_customers As ws_access
+    Dim headings_S() As String
+    ' PowerPoint
+    Dim pptApp As PowerPoint.Application
+    Dim ppt As PowerPoint.Presentation
+    Dim pptSlide As PowerPoint.Slide
+    Dim paste_shape As PowerPoint.Shape
+    ' Temporary
+    Dim headings_V() As Variant
+    Dim i As Long
+    Dim j As Long
+    Dim tmp_total As Long
+    Dim tmp_heading As String
+    Dim i_col_out As Long
+    Dim i_col_cash As Long
+    Dim i_col_day As Long
+    Dim tmp_S As String
+    Dim t_sleep As Long
+' VARIABLE INSTANTIATION
+    t_sleep = 5000
+    ' PowerPoint
+    Set pptApp = New PowerPoint.Application
+    Set ppt = pptApp.Presentations.Open("C:\Users\edwar\OneDrive\Documents\4 Shires\Alex Automation\4 Shires Books Public\Pivot Linked.pptx")
+    Set pptSlide = ppt.Slides(2)
+    pptSlide.Select
+    Sleep t_sleep
+    ' Worksheet Relation
+    Set ws_rel = New ws_relation
+    Set wb_me = ActiveWorkbook
+    Set ws_out = create_sheet_out(wb_me)
+    Set ws_anal = wb_me.Sheets("Analysis")
+    get_downloaded_sheets wb_me, wb_cash, ws_cash, wb_day, ws_day, wb_customers, ws_customers, ws_rel, t_sleep
+    ' Worksheet Containers
+    ' Cashbook
+    headings_V = Array("BATCH NO", "BATCH DATE", "TRAN DATE", "CUST REF", "CUSTOMER NAME", "", "TRAN REF", "FURTHER REF", "", "", "", "", "", "", "CASH", "DISCOUNT", "", "", "", "", "", "", "")
+    convert_1D_Variant_2_String headings_V, headings_S
+    Set wsc_cash = New ws_access
+    wsc_cash.Init ws_cash, "Cashbook", headings_S, ColumnHeaders, 7, True, 3, False, 1, 0, 4
+    ws_rel.AddWSC wsc_cash
+    ' Daybook
+    Erase headings_S
+    Erase headings_V
+    headings_V = Array("BATCH NO", "BATCH DATE", "TRAN DATE", "CUST REF", "CUST NAME", "CASH STATUS", "TRAN REF", "FURTHER REF", "", "GOODS", "VAT", "TOT INV", "TOT CRN", "ACC STAT", "", "", "", "", "", "", "", "", "")
+    convert_1D_Variant_2_String headings_V, headings_S
+    Set wsc_day = New ws_access
+    wsc_day.Init ws_day, "Daybook", headings_S, ColumnHeaders, 7, True, 3, False, 1, 0, 4
+    If Not ws_rel.AddWSC(wsc_day) Then GoTo errhand
+    ' Customer List
+    Erase headings_S
+    Erase headings_V
+    headings_V = Array("", "", "", "A/C", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "Name")
+    convert_1D_Variant_2_String headings_V, headings_S
+    Set wsc_customers = New ws_access
+    wsc_customers.Init ws_customers, "Customer List", headings_S, ColumnHeaders, 4, True, 6, False, 2, 0, 7, 0, 10
+    If Not ws_rel.AddWSC(wsc_customers) Then GoTo errhand
+    ' Export
+    ' Set ws_out = create_sheet_out()
+    Erase headings_S
+    Erase headings_V
+    headings_V = Array("BATCH NO", "BATCH DATE", "Date", "Account Reference", "CUST NAME", "IMPORT ID NO.", "Reference", "Extra Reference", "User Name", "", "Tax Amount", "", "", "CASH STATUS", "", "", "Type", "Nominal A/C Ref", "Details", "Net Amount", "Tax Code", "TOT INV", "CUST NAME VLOOKUP")
+    convert_1D_Variant_2_String headings_V, headings_S
+    Set wsc_out = New ws_access
+    wsc_out.Init ws_out, "Export", headings_S, ColumnHeaders, 7, True, 1, False, 1, 0, 2
+    If Not ws_rel.AddWSC(wsc_out) Then GoTo errhand
+    ' Worksheet size
+    tmp_total = wsc_cash.RowMax - wsc_cash.RowMin + 1
+' PROCESSING ACCELERATION
+    ' Disable automatic spreadsheet calculation - prevents refreshing of whole ws on each cell entry
+    Application.Calculation = xlCalculationManual
+    ' Disable screen updating
+    Application.ScreenUpdating = False
+' METHODS
+    ' Populate export wsc with references from cashbook, daybook
+    wsc_out.ResizeLocal wsc_out.ColumnMin, wsc_out.ColumnMax, wsc_out.RowMin, wsc_cash.RowMax - wsc_cash.RowMin + wsc_day.RowMax - wsc_day.RowMin + wsc_out.RowMin + 1, True
+    ' Cashbook
+    For j = 1 To tmp_total
+        ' ' Set key value for record-wise population
+        ' wsc_out.SetCellDataLocal j, wsc_out.ColumnSearch, wsc_cash.GetCellDataLocal(j, wsc_cash.ColumnSearch)
+        
+        ' Set all available values
+        For i = 1 To ws_rel.nHeadings
+            i_col_out = wsc_out.ColumnID(CStr(i), True)
+            If i_col_out > 0 Then
+                wsc_out.Cell(j + wsc_out.RowMin - 1, i_col_out + wsc_out.ColumnMin - 1).Interior.ColorIndex = 17 ' 6
+                i_col_cash = wsc_cash.ColumnID(CStr(i), True)
+                If i_col_cash > 0 Then
+                    If tmp_heading = "Net Amount" Then
+                        wsc_out.SetCellDataLocal j, i_col_out, CMoney_String(CDbl(wsc_cash.GetCellDataLocal(j, i_col_cash)))
+                    Else
+                        wsc_out.SetCellDataLocal j, i_col_out, wsc_cash.GetCellDataLocal(j, i_col_cash)
+                    End If
+                Else
+                    tmp_heading = wsc_out.HeadingName(i)
+                    If tmp_heading = "Type" Or tmp_heading = "Details" Then
+                        ' pass
+                    ElseIf tmp_heading = "Nominal A/C Ref" Then
+                        tmp_S = Left(wsc_cash.GetCellDataLocal(j, wsc_cash.ColumnID("FURTHER REF")), 2)
+                        If tmp_S = "BA" Or tmp_S = "BX" Or tmp_S = "CQ" Then
+                            wsc_out.SetCellDataLocal j, i_col_out, "1200"
+                            wsc_out.SetCellDataLocal j, wsc_out.ColumnID("Tax Code"), "T9"
+                            If wsc_cash.GetCellDataLocal(j, wsc_cash.ColumnID("FURTHER REF")) = "BX DUPLICATE ENTRY" Then
+                                wsc_out.SetCellDataLocal j, wsc_out.ColumnID("Details"), "REFUND"
+                                wsc_out.SetCellDataLocal j, wsc_out.ColumnID("Type"), "SP"
+                            Else
+                                wsc_out.SetCellDataLocal j, wsc_out.ColumnID("Details"), "PAYMENT RECEIVED"
+                                wsc_out.SetCellDataLocal j, wsc_out.ColumnID("Type"), "SA"
+                            End If
+                        ElseIf tmp_S = "CA" Then
+                            wsc_out.SetCellDataLocal j, i_col_out, "1230"
+                            If CLng(wsc_cash.GetCellDataLocal(j, wsc_cash.ColumnID("CASH"))) < 0 Then
+                                wsc_out.SetCellDataLocal j, wsc_out.ColumnID("Details"), "REFUND"
+                                wsc_out.SetCellDataLocal j, wsc_out.ColumnID("Type"), "SP"
+                            Else
+                                wsc_out.SetCellDataLocal j, wsc_out.ColumnID("Details"), "PAYMENT RECEIVED"
+                                wsc_out.SetCellDataLocal j, wsc_out.ColumnID("Type"), "SA"
+                            End If
+                        ElseIf tmp_S = "CC" Or tmp_S = "WE" Then
+                            wsc_out.SetCellDataLocal j, i_col_out, "1250"
+                            If CLng(wsc_cash.GetCellDataLocal(j, wsc_cash.ColumnID("CASH"))) < 0 Then
+                                wsc_out.SetCellDataLocal j, wsc_out.ColumnID("Details"), "REFUND"
+                                wsc_out.SetCellDataLocal j, wsc_out.ColumnID("Type"), "SP"
+                            Else
+                                wsc_out.SetCellDataLocal j, wsc_out.ColumnID("Details"), "PAYMENT RECEIVED"
+                                wsc_out.SetCellDataLocal j, wsc_out.ColumnID("Type"), "SA"
+                            End If
+                        Else
+                            wsc_out.SetCellDataLocal j, i_col_out, "1255"
+                            If CLng(wsc_cash.GetCellDataLocal(j, wsc_cash.ColumnID("CASH"))) < 0 Then
+                                wsc_out.SetCellDataLocal j, wsc_out.ColumnID("Details"), "REFUND"
+                                wsc_out.SetCellDataLocal j, wsc_out.ColumnID("Type"), "SP"
+                            Else
+                                wsc_out.SetCellDataLocal j, wsc_out.ColumnID("Details"), "PAYMENT RECEIVED"
+                                wsc_out.SetCellDataLocal j, wsc_out.ColumnID("Type"), "SA"
+                            End If
+                        End If
+                    ElseIf tmp_heading = "Net Amount" Then
+                        wsc_out.SetCellDataLocal j, i_col_out, CMoney_String(Abs(CDbl(wsc_cash.GetCellDataLocal(j, wsc_cash.ColumnID("CASH")))))
+                    ElseIf tmp_heading = "Tax Code" Then
+                        wsc_out.SetCellDataLocal j, i_col_out, "T9"
+                    ElseIf tmp_heading = "Tax Amount" Then
+                        wsc_out.SetCellDataLocal j, i_col_out, "'0.00"
+                    ElseIf tmp_heading = "User Name" Then
+                        wsc_out.SetCellDataLocal j, i_col_out, "ALEX-IMPORTED"
+                    End If
+                End If
+            End If
+        Next
+    Next
+    ' Daybook
+    For j = 1 To wsc_day.RowMax - wsc_day.RowMin + 1
+        ' ' Set key value for record-wise population
+        ' wsc_out.SetCellDataLocal tmp_total + j, wsc_out.ColumnSearch, wsc_day.GetCellDataLocal(j, wsc_day.ColumnSearch)
+        
+        ' Set all available values
+        For i = 1 To ws_rel.nHeadings
+            i_col_out = wsc_out.ColumnID(CStr(i), True)
+            If i_col_out > 0 Then
+                wsc_out.Cell(tmp_total + j + wsc_out.RowMin - 1, i_col_out + wsc_out.ColumnMin - 1).Interior.ColorIndex = 42 ' 50
+                i_col_day = wsc_day.ColumnID(CStr(i), True)
+                tmp_heading = wsc_out.HeadingName(i)
+                If i_col_day > 0 Then
+                    ' If tmp_heading = "Tax Amount" Or tmp_heading = "TOT INV" Then
+                    '     wsc_out.SetCellDataLocal tmp_total + j, i_col_out, CMoney_String(CDbl(wsc_day.GetCellDataLocal(j, i_col_day)))
+                    ' Else
+                    wsc_out.SetCellDataLocal tmp_total + j, i_col_out, wsc_day.GetCellDataLocal(j, i_col_day)
+                    ' End If
+                Else
+                    If tmp_heading = "Type" Then
+                        ' pass
+                        If CLng(wsc_day.GetCellDataLocal(j, wsc_day.ColumnID("GOODS"))) < 0 Then
+                            wsc_out.SetCellDataLocal tmp_total + j, wsc_out.ColumnID("Type"), "SC"
+                            wsc_out.SetCellDataLocal tmp_total + j, wsc_out.ColumnID("Details"), "CREDIT"
+                        Else
+                            wsc_out.SetCellDataLocal tmp_total + j, wsc_out.ColumnID("Type"), "SI"
+                            wsc_out.SetCellDataLocal tmp_total + j, wsc_out.ColumnID("Details"), "INVOICE"
+                        End If
+                    ElseIf tmp_heading = "Nominal A/C Ref" Then
+                        wsc_out.SetCellDataLocal tmp_total + j, wsc_out.ColumnSearch, "4000"
+                    ElseIf tmp_heading = "Net Amount" Then
+                        wsc_out.SetCellDataLocal tmp_total + j, i_col_out, CMoney_String(Abs(CDbl(wsc_day.GetCellDataLocal(j, wsc_day.ColumnID("GOODS")))))
+                        wsc_out.SetCellDataLocal tmp_total + j, wsc_out.ColumnID("Tax Amount"), CMoney_String(Abs(CDbl(wsc_day.GetCellDataLocal(j, wsc_day.ColumnID("VAT")))))
+                        wsc_out.SetCellDataLocal tmp_total + j, wsc_out.ColumnID("TOT INV"), CMoney_String(CDbl(wsc_day.GetCellDataLocal(j, wsc_day.ColumnID("GOODS"))) + CDbl(wsc_day.GetCellDataLocal(j, wsc_day.ColumnID("VAT"))))
+                    ElseIf tmp_heading = "Tax Code" Then
+                        wsc_out.SetCellDataLocal tmp_total + j, i_col_out, "T1"
+                    ElseIf tmp_heading = "User Name" Then
+                        wsc_out.SetCellDataLocal tmp_total + j, i_col_out, "ALEX-IMPORTED"
+                    End If
+                End If
+            End If
+        Next
+    Next
+    ' Customer name 'vlookup'
+    wsc_out.ColumnSearch = wsc_out.ColumnID("Account Reference")
+    ws_rel.Populate "Export", False, "Customer List", False
+    wsc_out.ExportLocalData2WS
+    
+    ' ' Populate matching columns
+    ' ws_rel.Populate "Export", False, "Cashbook", False, True
+    ' ws_rel.Populate "Export", False, "Daybook", False, True
+    
+' RETURNS
+    ' WS data
+    wsc_out.ExportLocalData2WS
+    ' table objects
+    ws_out.ListObjects.Add(xlSrcRange, ws_out.Range("$A$1:$W$" & CStr(wsc_out.RowMax)), , xlYes).name = "tbl_audit" ' 'Audit Trail'!
+    ws_anal.PivotTables("pivot_audit").ClearTable
+    With ws_anal.PivotTables("pivot_audit")
+        .ColumnGrand = True
+        .HasAutoFormat = True
+        .DisplayErrorString = False
+        .DisplayNullString = True
+        .EnableDrilldown = True
+        .ErrorString = ""
+        .MergeLabels = False
+        .NullString = ""
+        .PageFieldOrder = 2
+        .PageFieldWrapCount = 0
+        .PreserveFormatting = True
+        .RowGrand = True
+        .SaveData = True
+        .PrintTitles = False
+        .RepeatItemsOnEachPrintedPage = True
+        .TotalsAnnotation = False
+        .CompactRowIndent = 1
+        .InGridDropZones = False
+        .DisplayFieldCaptions = True
+        .DisplayMemberPropertyTooltips = False
+        .DisplayContextTooltips = True
+        .ShowDrillIndicators = True
+        .PrintDrillIndicators = False
+        .AllowMultipleFilters = False
+        .SortUsingCustomLists = True
+        .FieldListSortAscending = False
+        .ShowValuesRow = False
+        .CalculatedMembersInFilters = False
+        .RowAxisLayout xlCompactRow
+    End With
+    With ws_anal.PivotTables("pivot_audit").PivotCache
+        .RefreshOnFileOpen = False
+        .MissingItemsLimit = xlMissingItemsDefault
+    End With
+    ws_anal.PivotTables("pivot_audit").RepeatAllLabels xlRepeatLabels
+    With ws_anal.PivotTables("pivot_audit").PivotFields("CUST NAME")
+        .orientation = xlRowField
+        .position = 1
+    End With
+    ws_anal.PivotTables("pivot_audit").AddDataField ws_anal.PivotTables( _
+        "pivot_audit").PivotFields("Net Amount"), "Sum of Net Amount", xlSum
+    ' Bring presentation to front
+    ' AppActivate ppt.path
+    ' Set ppt = pptApp.Presentations.Open("C:\Users\edwar\OneDrive\Documents\4 Shires\Alex Automation\4 Shires Books Public\Pivot Linked.pptx")
+    ' PowerPoint.Presentations(ppt.path).Windows(1).Activate
+    ws_anal.Range("A1:B27").Copy
+    ' ppt.Slides(2).Shapes(1).TextFrame.TextRange.PasteSpecial
+    pptSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
+    ' pptApp.ActiveWindow.View.PasteSpecial ppPasteEnhancedMetafile
+    Set paste_shape = pptSlide.Shapes(pptSlide.Shapes.count)
+    paste_shape.Left = paste_shape.Left - 150
+    ws_anal.Range("A28:B54").Copy
+    ' ppt.Slides(2).Shapes(1).TextFrame.TextRange.PasteSpecial
+    pptSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
+    ' pptApp.ActiveWindow.View.PasteSpecial ppPasteEnhancedMetafile
+    Set paste_shape = pptSlide.Shapes(pptSlide.Shapes.count)
+    paste_shape.Left = paste_shape.Left + 150
+    ' Add overdue statuses
+    ws_anal.Cells(1, 3).value = "Overdue Status"
+    ws_anal.Cells(1, 3).Interior.Color = RGB(209, 225, 239) ' "#D1E1EF"
+    ws_anal.Cells(1, 3).Font.Bold = True
+    ws_anal.Columns("C:C").ColumnWidth = 14.14
+    For i = 2 To 53 Step 1
+        If (i < 5) Then
+            ws_anal.Cells(i, 3).value = OverdueStatusName(i - 2)
+        Else
+            ws_anal.Cells(i, 3).value = OverdueStatusName(CLng(Rnd() * 2))
+        End If
+    Next
+    ' Emails
+    ' MsgBox "Ready to send emails?"
+    ' Sleep 25000
+        ' Scroll through processed data, ppt
+    mail_account_balances ws_anal, ws_customers
+' ERROR HANDLING
+errhand:
+    On Error Resume Next
+    wb_cash.Close
+    wb_day.Close
+    wb_customers.Close
+' endgame:
+' PROCESSING DECELARATION
+    ' Enable automatic spreadsheet calculation - prevents refreshing of whole ws on each cell entry
+    Application.Calculation = xlCalculationAutomatic
+    ' Enable screen updating
+    Application.ScreenUpdating = True
+End Sub
+
+Sub mail_account_balances(ByRef ws_anal As Worksheet, ByRef ws_customer As Worksheet)
+' FUNCTION
+    ' Contact all customers (as necessary) regarding their account balance
+' CONSTANTS
+    Const nCustomer = 52
+' VARIABLE DECLARATION
+    Dim olApp As Outlook.Application
+    ' Dim olNS As Outlook.Namespace
+    Dim ws_rel As ws_relation
+    Dim wsc_anal As ws_access
+    Dim wsc_customer As ws_access
+    Dim headings_V() As Variant
+    Dim headings_S() As String
+    ' Iterables
+    Dim iRow As Long
+    Dim iRowCustomer As Long
+    Dim colIDAnal_Company As Long
+    Dim colIDAnal_Balance As Long
+    Dim colIDAnal_status As Long
+    Dim colIDCustomer_Contact As Long
+    Dim colIDCustomer_Address As Long
+' VARIABLE INSTANTIATION
+    Set olApp = New Outlook.Application
+    ' Set olNS = olApp.GetNamespace("MAPI")
+    ' Worksheet Relation
+    Set ws_rel = New ws_relation
+    ' Worksheet Containers
+    ' Customers
+    headings_V = Array("A/C", "Name", "Contact Name", "Telephone", "Email", "", "")
+    convert_1D_Variant_2_String headings_V, headings_S
+    Set wsc_customer = New ws_access
+    ' Init(ByRef ws As Worksheet, ByVal name As String, ByRef headings() As String, Optional Orient As orientation = orientation.ColumnHeaders, Optional search_col As Long = 1, Optional search_col_is_heading_index As Boolean = False, Optional search_row As Long = 1, Optional search_row_is_heading_index As Boolean = False, Optional col_min As Long = 1, Optional col_max As Long = 0, Optional row_min As Long = 2, Optional row_max As Long = 0, Optional gap_max As Long = 1, Optional mutable_headings As Boolean = False)
+    ' wsc_customer.Init ws_customer, "Customers", headings_S, ColumnHeaders, 2, True, 6, False, 1, 0, 7
+    wsc_customer.Init ws_customer, "Customer List", headings_S, ColumnHeaders, 2, True, 6, False, 2, 0, 7, 0, 10
+    ws_rel.AddWSC wsc_customer
+    ' Analysis
+    Erase headings_S
+    Erase headings_V
+    headings_V = Array("", "Row Labels", "", "", "", "Sum of Net Amount", "Overdue Status")
+    convert_1D_Variant_2_String headings_V, headings_S
+    Set wsc_anal = New ws_access
+    wsc_anal.Init ws_anal, "Analysis", headings_S, ColumnHeaders, 1, False, 1, False, 1, 0, 2
+    If Not ws_rel.AddWSC(wsc_anal) Then GoTo errhand
+    ' Indices
+    colIDAnal_Company = wsc_anal.ColumnID("Row Labels")
+    colIDAnal_Balance = wsc_anal.ColumnID("Sum of Net Amount")
+    colIDAnal_status = wsc_anal.ColumnID("Overdue Status")
+    colIDCustomer_Contact = wsc_customer.ColumnID("Contact Name")
+    colIDCustomer_Address = wsc_customer.ColumnID("Email")
+' METHODS
+    For iRow = 2 To 5 Step 1 ' 1 + nCustomer
+        iRowCustomer = wsc_customer.Match(wsc_anal.GetCellDataLocal(iRow - 1, colIDAnal_Company))
+        mail_account_balance olApp, _
+            wsc_customer.GetCellDataLocal(iRow - 1, colIDCustomer_Contact), _
+            wsc_customer.GetCellDataLocal(iRow - 1, colIDCustomer_Address), _
+            GetOverdueStatus(wsc_anal.GetCellDataLocal(iRow - 1, colIDAnal_status)), _
+            CLng(wsc_anal.GetCellDataLocal(iRow - 1, colIDAnal_Balance))
+    Next
+' RETURNS
+' ERROR HANDLING
+errhand:
+    Exit Sub
+End Sub
+
+Sub mail_account_balance(ByRef olApp As Outlook.Application, ByVal name As String, ByVal address As String, ByVal overdue_status As OverdueStatus, ByVal balance As Long)
+' FUNCTION
+    ' Send email to account holder regarding balance
+' ARGUMENTS
+    ' Outlook.Application olApp
+    ' String name
+    ' String address
+    ' OverdueStatus overdue_status
+    ' String balance
+' VARIABLE DECLARATION
+    Dim new_mail As Object
+    Dim mail_body As String
+    Dim subj As String
+    
+' VARIABLE INSTANTIATION
+    Set new_mail = olApp.CreateItem(olMailItem)
+    
+    mail_body = "<html>"
+    mail_body = mail_body & "<p>Dear " & name & ",</p>"
+    
+' METHODS
+    Select Case overdue_status
+        Case OverdueStatus.OVERDUE:
+            mail_body = mail_body & "<p>Your account is overdue with a balance of £" & CStr(balance) & ".<br>"
+            mail_body = mail_body & "Please resolve your balance as soon as possible.</p>"
+            subj = "Overdue account balance"
+        Case OverdueStatus.SUPEROVERDUE:
+            mail_body = mail_body & "<p><span style=""color: red;""><strong>Your account is overdue with a balance of £" & CStr(balance) & ".</strong></span><br>"
+            mail_body = mail_body & "Please resolve your balance as soon as possible.</p>"
+            subj = "REMINDER: Overdue account balance"
+        Case Else:
+            mail_body = mail_body & "Your account has a negative balance of £" & CStr(balance) & ".<br>"
+            mail_body = mail_body & "This balance is due to be settled by " & Format(DateSerial(2023, Month(Now()) + 1, -1), "Long Date") & ".</p>"
+            subj = "Negative account balance"
+    End Select
+        
+    mail_body = mail_body & "<p>Kind regards,<br>"
+    mail_body = mail_body & "Lord Edward Middleton-Smith<br>"
+    mail_body = mail_body & "Director<br>"
+    mail_body = mail_body & "Precision And Research Technology Systems Limited"
+    
+' RETURNS
+    With new_mail
+        .To = address
+        .Subject = subj
+        .HTMLBody = mail_body
+        .Display
+    End With
+End Sub
+
+Sub get_downloaded_sheets(ByRef wb As Workbook, ByRef wb_cash As Workbook, ByRef ws_cash As Worksheet, ByRef wb_day As Workbook, ByRef ws_day As Worksheet, ByRef wb_customers As Workbook, ByRef ws_customers As Worksheet, ByRef ws_rel As ws_relation, ByVal t_sleep As Long)
+' FUNCTION
+    ' Get downloaded cashbook, daybook, and customer list
+' ARGUMENTS
+    ' Worksheet ws_cash
+    ' Worksheet ws_day
+    ' Worksheet ws_customers
+    ' ws_relation ws_rel
+' PROCESSING ACCELERATION
+' CONSTANTS
+' VARIABLE DECLARATION
+    ' Dim wb_cash As Workbook
+    ' Dim wb_day As Workbook
+    ' Dim wb_customers As Workbook
+    Dim fold As Scripting.Folder
+    Dim f As Scripting.File
+    Dim objFSO As Scripting.FileSystemObject
+    Dim path_S As String
+    Dim suffix As String
+    Dim iTmp As Long
+    Dim sTmp As String
+' ARGUMENT VALIDATION
+' VARIABLE INSTANTIATION
+    Set objFSO = New Scripting.FileSystemObject
+    path_S = GetLocalPath(wb.FullName)
+    path_S = Left(path_S, Len(path_S) - Len(wb.name) - 1)
+    If (Left(path_S, 41) = "https://d.docs.live.net/5728c5526437cee2/") Then
+        path_S = "C:\Users\edwar\OneDrive\" & Mid(path_S, 42)
+    End If
+    Debug.Print path_S
+    Set fold = objFSO.GetFolder(path_S)
+' METHODS
+    For Each f In fold.Files
+        suffix = f.name
+        iTmp = InStr(1, suffix, ".xl")
+        If iTmp > 0 Then
+            suffix = Mid(suffix, iTmp)
+            suffix = Mid(suffix, 2, 2)
+            If suffix = "xl" Then
+            ' If f.Type = "Microsoft Macro-Enabled Workbook" Then
+                sTmp = f.name
+                If Not sTmp = wb.name Then
+                    If Left(sTmp, 10) = "SL DAYBOOK" Then ' daybook
+                        sTmp = f.path
+                        Debug.Print sTmp
+                        ' Set wb_day = Workbooks.Open(sTmp)
+                        Set wb_day = ws_rel.SafeOpenWB(sTmp)
+                        Set ws_day = wb_day.Sheets("Daybook")
+                        ws_day.Activate
+                        ws_day.Select
+                        Sleep t_sleep
+                    ElseIf Left(sTmp, 11) = "SL CASHBOOK" Then ' cashbook
+                        sTmp = f.path
+                        Debug.Print sTmp
+                        ' Set wb_cash = Workbooks.Open(sTmp)
+                        Set wb_cash = ws_rel.SafeOpenWB(sTmp)
+                        Set ws_cash = wb_cash.Sheets("Cashbook")
+                        ws_cash.Activate
+                        ws_cash.Select
+                        Sleep t_sleep
+                    ElseIf sTmp = "Customers.xlsx" Then ' customer list
+                        sTmp = f.path
+                        Debug.Print sTmp
+                        ' Set wb_customers = Workbooks.Open(sTmp)
+                        Set wb_customers = ws_rel.SafeOpenWB(sTmp)
+                        Set ws_customers = wb_customers.Sheets("Customer List")
+                        ws_customers.Activate
+                        ws_customers.Select
+                        Sleep t_sleep
+                    End If
+                End If
+            End If
+        End If
+    Next
+' RETURNS
+' ERROR HANDLING
+' PROCESSING DECELARATION
+End Sub
+
+Function create_sheet_out(ByRef wb As Workbook) As Worksheet
+' FUNCTION
+    ' Create new output sheet
+' ARGUMENTS
+    ' Workbook wb
+' PROCESSING ACCELERATION
+' CONSTANTS
+' VARIABLE DECLARATION
+    Dim ws As Worksheet
+    Dim headings_V() As Variant
+    Dim colours_V() As Variant
+    Dim i As Long
+    Dim N As Long
+    Dim found As Boolean
+    Dim w As Long
+' ARGUMENT VALIDATION
+' VARIABLE INSTANTIATION
+    headings_V = Array("Type", "Account Reference", "Nominal A/C Ref", "Department Code", "Date", "Reference", "Details", "Net Amount", "Tax Code", "Tax Amount", "Exchange Rate", "Extra Reference", "User Name", "Project Refn", "Cost Code Refn", "TOT INV", "IMPORT ID NO.", "BATCH NO", "BATCH DATE", "CASH STATUS", "NO", "CUST NAME", "CUST NAME VLOOKUP")
+    ' colours_V = Array("50", "50", "50", "27", "50", "27", "27", "50", "50", "50", "27", "27", "27", "27", "27", "15", "15", "15", "15", "15", "15", "15", "15")
+    colours_V = Array("42", "42", "42", "17", "42", "17", "17", "42", "42", "42", "17", "17", "17", "17", "17", "15", "15", "15", "15", "15", "15", "15", "15")
+    N = SizeArrayDim_Variant(headings_V)
+    Set ws = wb.Sheets.Add()
+    ' Name ws
+    found = True
+    i = 0
+    Do While found
+        found = False
+        For w = 1 To wb.Sheets.count
+            If i = 0 Then
+                If wb.Sheets.Item(w).name = "Audit Trail" Then
+                    found = True
+                    Exit For
+                End If
+            Else
+                If wb.Sheets.Item(w).name = "Audit Trail " & CStr(i) Then
+                    found = True
+                    Exit For
+                End If
+            End If
+        Next
+        If found Then i = i + 1
+    Loop
+    If i = 0 Then
+        ws.name = "Audit Trail"
+    Else
+        ws.name = "Audit Trail " & CStr(i)
+    End If
+' METHODS
+    For i = 1 To N
+        ws.Cells(1, i).value = headings_V(i)
+        ws.Cells(1, i).Interior.ColorIndex = CLng(colours_V(i))
+    Next
+' RETURNS
+    Set create_sheet_out = ws
+' ERROR HANDLING
+' PROCESSING DECELARATION
+End Function
+
+Function OverdueStatusName(ByVal overdue_status As OverdueStatus) As String
+    Select Case overdue_status
+        Case UNDUE:
+            OverdueStatusName = "Not due"
+        Case OVERDUE:
+            OverdueStatusName = "Overdue"
+        Case SUPEROVERDUE:
+            OverdueStatusName = "Super Overdue"
+    End Select
+End Function
+
+Function GetOverdueStatus(ByVal overdue_status As String) As OverdueStatus
+    Select Case overdue_status
+        Case "Not due":
+            GetOverdueStatus = OverdueStatus.UNDUE
+        Case "Overdue":
+            GetOverdueStatus = OverdueStatus.OVERDUE
+        Case "Super Overdue":
+            GetOverdueStatus = OverdueStatus.SUPEROVERDUE
+    End Select
+End Function

src/Range_Strings.bas

@@ -0,0 +1,70 @@
+' Author: Edward Middleton-Smith
+' Precision And Research Technology Systems Limited
+
+
+' MODULE INITIALISATION
+' Set array start index to 1 to match spreadsheet indices
+Option Base 1
+' Forced Variable Declaration
+Option Explicit
+
+
+Function Range_1D_String(ByRef ws As Worksheet, ByVal range_str As String) As String()
+' FUNCTION
+    ' Get range of worksheet as 1D String array
+' ARGUMENTS
+    ' Worksheet ws
+    ' String range_str
+' VARIABLE DECLARATION
+    Dim my_range() As Variant
+    Dim sz_x As Long
+    Dim sz_y As Long
+    Dim i As Long
+    Dim N As Long
+    Dim strs() As String
+    Dim out_err() As String
+' ARGUMENT VALIDATION
+    ReDim out_err(1)
+    out_err(1) = "Error"
+    If Not valid_range_String(range_str) Or ws Is Nothing Then
+        Range_1D_String = out_err
+        Exit Function
+    End If
+' VARIABLE INSTANTIATION
+    my_range = ws.Range(range_str).value
+    sz_x = SizeArrayDim_Variant(my_range, 2)
+    sz_y = SizeArrayDim_Variant(my_range, 1)
+    If (sz_x = 0 Or sz_y = 0 Or (sz_x > 1 And sz_y > 1)) Then
+        Range_1D_String = out_err
+        Exit Function
+    End If
+    N = max_Long(sz_x, sz_y)
+    ReDim strs(N)
+' METHODS
+    For i = 1 To N
+        If sz_x > sz_y Then
+            strs(i) = my_range(1, i)
+        Else
+            strs(i) = my_range(i, 1)
+        End If
+    Next
+' RETURNS
+    Range_1D_String = strs
+End Function
+
+Function Range_String(ByVal col_min As Long, ByVal col_max As Long, ByVal row_min As Long, ByVal row_max As Long) As String
+' FUNCTION
+    ' Create range string from minimum and maximum positions
+' ARGUMENTS
+    ' Long col_min
+    ' Long col_max
+    ' Long row_min
+    ' Long row_max
+' ARGUMENT VALIDATION
+    Range_String = "Error: Invalid coordinates"
+    If row_max < 1 Then row_max = 1048576
+    If col_max < 1 Then col_max = 16384
+    If Not (valid_coordinate(row_min, col_min) And valid_coordinate(row_max, col_max)) Then Exit Function
+' RETURNS
+    Range_String = get_col_str(col_min) & CStr(row_min) & ":" & get_col_str(col_max) & CStr(row_max)
+End Function

src/String_Operations.bas

@@ -0,0 +1,175 @@
+' Author: Edward Middleton-Smith
+' Precision And Research Technology Systems Limited
+
+
+' MODULE INITIALISATION
+' Set array start index to 1 to match spreadsheet indices
+Option Base 1
+' Forced Variable Declaration
+Option Explicit
+
+
+Function is_numeric(ByVal numeric_chars As String) As Boolean
+' FUNCTION
+    ' Evaluate if all characters in numeric_chars are numeric
+' ARGUMENTS
+    ' String numeric_chars
+' VARIABLE DECLARATION
+    Dim i As Long
+    Dim asci_i As Long
+    Dim valid As Boolean
+' ARGUMENT VALIDATION
+    If numeric_chars = "" Then Exit Function
+' VARIABLE INSTANTIATION
+    valid = True
+' METHODS
+    For i = 1 To Len(numeric_chars)
+        asci_i = Asc(Mid(numeric_chars, i, 1))
+        valid = valid And (asci_i >= 48 And asci_i <= 57)
+    Next
+' RETURNS
+    is_numeric = valid
+End Function
+
+Function is_alphabetic(ByVal alphabetic_chars As String) As Boolean
+' FUNCTION
+    ' Evaluate if all characters in alphabetic_chars are alpabetic
+' ARGUMENTS
+    ' String numeric_chars
+' VARIABLE DECLARATION
+    Dim i As Long
+    Dim asci_i As Long
+    Dim valid As Boolean
+' ARGUMENT VALIDATION
+    If alphabetic_chars = "" Then Exit Function
+' VARIABLE INSTANTIATION
+    valid = True
+' METHODS
+    For i = 1 To Len(alphabetic_chars)
+        asci_i = Asc(Mid(alphabetic_chars, i, 1))
+        valid = valid And ((asci_i >= 65 And asci_i <= 90) Or (asci_i >= 97 And asci_i <= 122))
+    Next
+' RETURNS
+    is_alphabetic = valid
+End Function
+
+Function get_col_str(ByVal col_ID As Long) As String
+' FUNCTION
+    ' Return column ID as String from Long
+' ARGUMENTS
+    ' Long col_ID
+' VARIABLE DECLARATION
+    Dim strID As String
+    Dim i As Double
+    Dim N As Double
+    Dim temp As Long
+    Dim remainder As Double
+' ARGUMENT VALIDATION
+    If col_ID < 1 Then Exit Function
+' VARIABLE INSTANTIATION
+    N = max_Double(0, Div_Double(Log(col_ID), Log(26)))
+    If Not Mod_Double(Log(col_ID), Log(26)) = 0# Or col_ID = 1 Then N = N + 1
+' METHODS
+    For i = 1 To N
+        temp = ((col_ID - 1) Mod (26 ^ i)) \ (26 ^ (i - 1)) + 1
+        strID = Chr(64 + temp) & strID
+        col_ID = col_ID - temp * (26 ^ (i - 1))
+    Next
+' RETURNS
+    get_col_str = strID
+End Function
+
+Function get_col_ID(ByVal col_str As String) As Long
+' FUNCTION
+    ' Return column ID as Long from String
+' ARGUMENTS
+    ' String col_ID
+' VARIABLE DECLARATION
+    Dim col_ID As Long
+    Dim i As Long
+    Dim N As Long
+    Dim temp As Long
+    Dim remainder As Double
+' ARGUMENT VALIDATION
+    If Not is_alphabetic(col_str) Then Exit Function
+' VARIABLE INSTANTIATION
+    N = Len(col_str)
+' METHODS
+    For i = 1 To N
+        col_ID = col_ID + (Asc(Mid(col_str, i, 1)) - 64) * 26 ^ (N - i)
+    Next
+' RETURNS
+    get_col_ID = col_ID
+End Function
+
+Function Range_String_Coords(ByVal range_str As String) As Long()
+' FUNCTION
+    ' Array of coordinates in range_str (row_1, column_1, [row_2, column_2])
+' ARGUMENTS
+    ' String range_str
+' VARIABLE DECLARATION
+    Dim coords() As Long
+    Dim Phrases() As String
+    Dim Tmps() As String
+    Dim i As Long
+    Dim N As Long
+' ARGUMENT VALIDATION
+    If Not valid_range_String(range_str) Then Exit Function
+' VARIABLE INSTANTIATION
+    Tmps = Split(range_str, ":")
+    Phrases = change_array_base_String(Tmps)
+    N = SizeArrayDim_String(Phrases)
+    ReDim coords(N)
+' METHODS
+    For i = 1 To N
+        If i Mod 2 = 0 Then
+            coords(i) = get_col_ID(Phrases(i))
+        Else
+            coords(i) = CLng(Phrases(i))
+        End If
+    Next
+End Function
+
+Function CMoney_String(ByVal money_D As Double) As String
+' FUNCTION
+    ' Get string equivalent of double to 2 decimal places
+' ARGUMENTS
+    ' Double money_D
+' VARIABLE DECLARATION
+    ' Dim money_L As Long
+    Dim money_S As String
+    Dim iDot As Long
+' VARIABLE INSTANTIATION
+    ' money_D = 100 * money_D
+    ' money_L = money_D
+    ' money_D = money_L / 100
+    money_S = CStr(Round(money_D, 2))
+    iDot = InStr(1, money_S, ".")
+' RETURNS
+    If iDot < 1 Then
+        CMoney_String = "'" & money_S & ".00"
+    ElseIf iDot = Len(money_S) - 1 Then
+        CMoney_String = "'" & money_S & "0"
+    Else
+        CMoney_String = "'" & money_S
+    End If
+End Function
+
+Function Path2Name(ByVal FilePath As String) As String
+' FUNCTION
+    ' Get file name from path
+' ARGUMENTS
+    ' String FilePath
+' VARIABLE DECLARATION
+    Dim iSlash As Long
+' VARIABLE INSTANTIATION
+    Path2Name = FilePath
+    iSlash = InStr(1, Path2Name, "/")
+    If iSlash < 1 Then iSlash = InStr(1, Path2Name, "/")
+' METHODS
+    Do While iSlash > 0
+        Path2Name = Mid(Path2Name, iSlash + 1)
+        iSlash = InStr(1, Path2Name, "/")
+        If iSlash < 1 Then iSlash = InStr(1, Path2Name, "/")
+    Loop
+End Function

src/Validation_Comparison.bas

@@ -0,0 +1,204 @@
+' Author: Edward Middleton-Smith
+' Precision And Research Technology Systems Limited
+
+
+' MODULE INITIALISATION
+' Set array start index to 1 to match spreadsheet indices
+Option Base 1
+' Forced Variable Declaration
+Option Explicit
+
+
+Function input_Bool(ByVal bool_str As String) As Boolean
+' FUNCTION
+    ' Evaluate if String is equivalent to Boolean True
+' ARGUMENTS
+    ' String bool_str
+' VARIABLE DECLARATION
+    Dim L As Long
+' VARIABLE INSTANTIATION
+    bool_str = UCase(bool_str)
+    L = Len(bool_str)
+    input_Bool = False
+' METHODS
+    Select Case bool_str
+        Case "YES", "Y", "YEAH", "YESH", "YEESH", "YEES", "TRUE", "T":
+            input_Bool = True
+        Case Else:
+            If is_numeric(bool_str) Then
+                input_Bool = True
+            ElseIf L > 1 Then
+                If Left(bool_str, 1) = "_" And is_numeric(Mid(bool_str, 2)) Then
+                    input_Bool = True
+                End If
+            End If
+    End Select
+End Function
+
+
+Function input_Long(ByVal long_str As String, Optional Default As Long = 0) As Long
+' FUNCTION
+    ' Evaluate if String is equivalent to Long
+' ARGUMENTS
+    ' String long_str
+    ' Long default
+' METHODS
+    If is_numeric(long_str) Then
+        input_Long = CLng(long_str)
+    Else
+        input_Long = Default
+    End If
+End Function
+
+
+Function max_Long(ByRef a As Long, ByVal b As Long) As Long
+' FUNCTION
+    ' Maximum of two Long values
+' ARGUMENTS
+    ' Long a
+    ' Long b
+' METHODS
+    If a < b Then
+        max_Long = b
+    Else
+        max_Long = a
+    End If
+End Function
+
+
+Function min_Long(ByRef a As Long, ByVal b As Long) As Long
+' FUNCTION
+    ' Maximum of two Long values
+' ARGUMENTS
+    ' Long a
+    ' Long b
+' METHODS
+    min_Long = -max_Long(-a, -b)
+End Function
+
+
+Function max_Double(ByRef a As Double, ByVal b As Double) As Double
+' FUNCTION
+    ' Maximum of two Double values
+' ARGUMENTS
+    ' Double a
+    ' Double b
+' METHODS
+    If a < b Then
+        max_Double = b
+    Else
+        max_Double = a
+    End If
+End Function
+
+
+Function min_Double(ByRef a As Double, ByVal b As Double) As Double
+' FUNCTION
+    ' Maximum of two Double values
+' ARGUMENTS
+    ' Double a
+    ' Double b
+' METHODS
+    min_Double = -max_Double(-a, -b)
+End Function
+
+
+Function valid_coordinate(ByRef row As Long, ByVal col As Long) As Boolean
+' FUNCTION
+    ' Is coordinate on Worksheet?
+' ARGUMENTS
+    ' Long a
+    ' Long b
+' RETURNS
+    valid_coordinate = Not ((row < 1) Or (row > 1048576) Or (col < 1) Or (col > 16384))
+End Function
+
+
+Function valid_range_String(ByVal range_str As String) As Boolean
+' FUNCTION
+    ' Validate format of range string, e.g. "ABC123:BUD420"
+' ARGUMENTS
+    ' String range_str
+' VARIABLE DECLARATION
+    Dim Temps() As String
+    Dim Phrases() As String
+    Dim i As Long
+    Dim N As Long
+' VARIABLE INSTANTIATION
+    valid_range_String = False
+    Temps = Split(range_str, ":")
+    Phrases = change_array_base_String(Temps)
+    N = SizeArrayDim_String(Phrases)
+' METHODS
+    If N <> 2 Then
+        If (N = 1) Then
+            valid_range_String = valid_range_String_segment(range_str)
+        End If
+        Exit Function
+    End If
+    valid_range_String = True
+    For i = 1 To 2
+        valid_range_String = valid_range_String And valid_range_String_segment(Phrases(i))
+        If Not valid_range_String Then Exit Function
+    Next
+End Function
+
+
+Function valid_range_String_segment(ByVal range_str_segment As String) As Boolean
+' FUNCTION
+    ' Validate format of segment of range string, e.g. "ABC123"
+' ARGUMENTS
+    ' String range_str_segment
+' VARIABLE DECLARATION
+    Dim i As Long
+    Dim N As Long
+    Dim end_of_lets As Boolean
+    Dim temp As String
+' VARIABLE INSTANTIATION
+    N = Len(range_str_segment)
+    end_of_lets = False
+    valid_range_String_segment = False
+' METHODS
+    If N < 2 Then Exit Function
+    For i = 1 To N
+        temp = Mid(range_str_segment, i, 1)
+        If end_of_lets Then
+            If Not is_numeric(temp) Then Exit Function
+        ElseIf Not is_alphabetic(temp) Then
+            If is_numeric(temp) Then
+                end_of_lets = True
+            Else
+                Exit Function
+            End If
+        End If
+    Next
+' RETURNS
+    valid_range_String_segment = end_of_lets
+End Function
+
+
+Function error_msg(ByVal v As Variant, ByVal name As String, ByVal v_type As String, Optional v_expected As Variant = Nothing) As String
+' FUNCTION
+    ' Error message string for invalid argument
+' ARGUMENTS
+    ' Variant v - erroneous argument
+    ' String name - name of argument
+    ' String v_type - argument data type
+    ' Variant v_expected - expected value
+' VARIABLE DECLARATION
+    Dim str_v As String
+    Dim str_exp As String
+' VARIABLE INSTANTIATION
+    If v Is Nothing Then
+        str_v = "Nothing"
+    Else
+        str_v = CStr(v)
+    End If
+    If v_expected Is Nothing Then
+        str_exp = "Nothing"
+    Else
+        str_exp = CStr(v_expected)
+    End If
+' RETURNS
+    error_msg = "Invalid " & v_type & " " & name & "." & vbCrLf & "Value = " & str_v & vbCrLf & "Expected value = " & str_exp
+End Function

src/WS_Access.cls

@@ -0,0 +1,853 @@
+' Author: Edward Middleton-Smith
+' Precision And Research Technology Systems Limited
+
+
+' MODULE INITIALISATION
+' Set array start index to 1 to match spreadsheet indices
+Option Base 1
+' Forced Variable Declaration
+Option Explicit
+
+
+' PROPERTY DECLARATION
+Private v_ws As Worksheet
+Private v_name As String
+Private v_dir As orientation
+Private v_col_min As Long
+Private v_col_max As Long
+Private v_col_search As Long
+Private v_row_min As Long
+Private v_row_max As Long
+Private v_row_search As Long
+Private v_data() As String
+Private v_headings() As String
+Private v_col_IDs() As Long
+Private v_mutable_headings As Boolean
+Private v_gap_max As Long
+
+
+' PROPERTY METHODS
+Public Property Get Worksheet() As Worksheet
+    Set Worksheet = v_ws
+End Property
+
+Public Property Get name() As String
+    name = v_name
+End Property
+Public Property Let name(ByVal new_name As String)
+    v_name = new_name
+End Property
+
+Public Property Get Cell(ByVal row As Long, ByVal col As Long) As Range
+    Set Cell = v_ws.Cells(row, col)
+End Property
+
+Public Property Get Range(ByVal range_str As String) As Range
+    Set Range = v_ws.Range(range_str)
+End Property
+Public Sub SetRange_Variant(ByVal range_str As String, ByRef new_data() As Variant)
+' FUNCTION
+    ' Set Range of v_ws
+' ARGUMENTS
+    ' String range_str
+    ' Variant Matrix new_data
+' VARIABLE DECLARATION
+    Dim sz_x As Long
+    Dim sz_y As Long
+    Dim sz_z As Long
+    Dim out_data() As String
+    Dim range_coords() As Long
+' VARIABLE INSTANTIATION
+    sz_x = SizeArrayDim_Variant(new_data, 2)
+    sz_y = SizeArrayDim_Variant(new_data, 1)
+    sz_z = SizeArrayDim_Variant(new_data, 3)
+' ARGUMENT VALIDATION
+    ' string-literal decomposition of range string
+    If Not valid_range_String(range_str) Then
+        MsgBox "Invalid range string"
+        Exit Sub
+    End If
+    range_coords = Range_String_Coords(range_str)
+    ' Validate new coordinates
+    If Not (valid_coordinate(range_coords(1), range_coords(2)) And valid_coordinate(range_coords(3), range_coords(4))) Then
+        MsgBox "Invalid range string coordinates"
+        Exit Sub
+    End If
+    ' Validate new_data dimensions against range_str dimensions
+    If Not ((sz_x = range_coords(4) - range_coords(2) + 1) And (sz_x = range_coords(4) - range_coords(2) + 1) And (sz_z = 0)) Then
+        MsgBox "Inconsistent range and matrix dimensions"
+        Exit Sub
+    End If
+' METHODS
+    ' Compare new dimensions against current dimensions
+    If Not (range_coords(1) = v_row_min And range_coords(2) = v_col_min And range_coords(3) = v_row_max And range_coords(4) = v_col_max) Then
+        ResizeLocal range_coords(2), range_coords(4), range_coords(1), range_coords(3), True
+    End If
+' RETURNS
+    v_ws.Range(range_str).value = new_data
+    convert_2D_Variant_2_String new_data, out_data
+    Me.SetData out_data
+End Sub
+Public Sub SetRange_String(ByVal range_str As String, ByRef new_data() As String)
+' FUNCTION
+    ' Set Range of v_ws
+' ARGUMENTS
+    ' String range_str
+    ' String Matrix new_data
+' VARIABLE DECLARATION
+    Dim sz_x As Long
+    Dim sz_y As Long
+    Dim sz_z As Long
+    Dim range_coords() As Long
+    Dim i As Long
+    Dim j As Long
+' VARIABLE INSTANTIATION
+    sz_x = SizeArrayDim_String(new_data, 2)
+    sz_y = SizeArrayDim_String(new_data, 1)
+    sz_z = SizeArrayDim_String(new_data, 3)
+' ARGUMENT VALIDATION
+    ' string-literal decomposition of range string
+    If Not valid_range_String(range_str) Then
+        MsgBox "Invalid range string"
+        Exit Sub
+    End If
+    range_coords = Range_String_Coords(range_str)
+    ' Validate new coordinates
+    If Not (valid_coordinate(range_coords(1), range_coords(2)) And valid_coordinate(range_coords(3), range_coords(4))) Then
+        MsgBox "Invalid range string coordinates"
+        Exit Sub
+    End If
+    ' Validate new_data dimensions against range_str dimensions
+    If Not ((sz_x = range_coords(4) - range_coords(2) + 1) And (sz_x = range_coords(4) - range_coords(2) + 1) And (sz_z = 0)) Then
+        MsgBox "Inconsistent range and matrix dimensions"
+        Exit Sub
+    End If
+' METHODS
+    ' Compare new dimensions against current dimensions
+    If Not (range_coords(1) = v_row_min And range_coords(2) = v_col_min And range_coords(3) = v_row_max And range_coords(4) = v_col_max) Then
+        ResizeLocal range_coords(2), range_coords(4), range_coords(1), range_coords(3), True
+    End If
+' RETURNS
+    For i = v_col_min To v_col_max
+        For j = v_row_min To v_row_max
+            v_ws.Cells(j, i).value = new_data(j, i)
+        Next
+    Next
+    Me.SetData new_data
+End Sub
+
+Public Sub GetData(ByRef data_out() As String)
+    data_out = v_data
+End Sub
+Public Sub SetData(ByRef new_data() As String, Optional update_ws As Boolean = False)
+' FUNCTION
+    ' Set local data to new matrix, and optionally, update Worksheet
+' ARGUMENTS
+    ' String Matrix new_data
+    ' Boolean update_ws
+' VARIABLE DECLARATION
+    Dim sz_x As Long
+    Dim sz_y As Long
+    Dim sz_z As Long
+' VARIABLE INSTANTIATION
+    sz_x = SizeArrayDim_String(new_data, 2)
+    sz_y = SizeArrayDim_String(new_data, 1)
+    sz_z = SizeArrayDim_String(new_data, 3)
+' ARGUMENT VALIDATION
+    If Not ((sz_x = v_col_max - v_col_min + 1) And (sz_y = v_row_max - v_row_min + 1) And (sz_z = 0)) Then
+        MsgBox "Invalid dimensions to replace worksheet data"
+        Exit Sub
+    End If
+' METHODS
+    Erase v_data
+' RETURNS
+    v_data = new_data
+    If update_ws Then ExportLocalData2WS
+End Sub
+Public Sub SetEmptyData(ByRef new_data() As String, Optional update_ws As Boolean = False)
+' FUNCTION
+    ' Set local data to new matrix, and optionally, update Worksheet. Only populate empty cells
+' ARGUMENTS
+    ' String Matrix new_data
+    ' Boolean update_ws
+' VARIABLE DECLARATION
+    Dim sz_x As Long
+    Dim sz_y As Long
+    Dim sz_z As Long
+    Dim i As Long
+    Dim j As Long
+' VARIABLE INSTANTIATION
+    sz_x = SizeArrayDim_String(new_data, 2)
+    sz_y = SizeArrayDim_String(new_data, 1)
+    sz_z = SizeArrayDim_String(new_data, 3)
+' ARGUMENT VALIDATION
+    If Not ((sz_x = v_col_max - v_col_min + 1) And (sz_y = v_row_max - v_row_min + 1) And (sz_z = 0)) Then
+        MsgBox "Invalid dimensions to replace worksheet data"
+        Exit Sub
+    End If
+' METHODS
+    For j = 1 To sz_y
+        For i = 1 To sz_x
+            If v_data(j, i) = "" Then v_data(j, i) = new_data(j, i)
+        Next
+    Next
+' RETURNS
+    If update_ws Then ExportLocalData2WS
+End Sub
+
+Public Function GetCellDataLocal(ByVal row As Long, ByVal col As Long) As String
+' FUNCTION
+    ' Get value from cell of local copy of Worksheet data
+' ARGUMENTS
+    ' Long row - relative row index in data table
+    ' Long col - relative column index in data table
+' VARIABLE INSTANTIATION
+    If ((row > v_row_max - v_row_min + 1) Or (row < 1) Or (col > v_col_max - v_col_min + 1) Or (col < 1)) Then
+        Debug.Print "Invalid cell index. Row = " & CStr(row) & ", column = " & CStr(col)
+        Exit Function
+    End If
+' RETURNS
+    GetCellDataLocal = v_data(row, col)
+End Function
+Public Sub SetCellDataLocal(ByVal row As Long, ByVal col As Long, ByVal new_value As String)
+' FUNCTION
+    ' Set value of cell of local copy of Worksheet data
+' ARGUMENTS
+    ' Long row - relative row index in data table
+    ' Long col - relative column index in data table
+' VARIABLE INSTANTIATION
+    If ((row > v_row_max - v_row_min + 1) Or (row < 1) Or (col > v_col_max - v_col_min + 1) Or (col < 1)) Then
+        Debug.Print "Invalid cell index. Row = " & CStr(row) & ", column = " & CStr(col)
+        Exit Sub
+    End If
+' METHODS
+    v_data(row, col) = new_value
+End Sub
+
+Public Property Get nHeadings() As Long
+    nHeadings = SizeArrayDim_String(v_headings)
+End Property
+
+Public Property Get HeadingName(ByVal h_index As Long) As String
+' FUNCTION
+    ' Get heading text from index in v_headings
+' ARGUMENTS
+    ' Long h_index - index of desired heading in v_headings
+' VARIABLE DECLARATION
+    Dim n_h As Long
+' VARIABLE INSTANTIATION
+    n_h = nHeadings
+    HeadingName = "Error: Invalid index"
+' ARGUMENT VALIDATION
+    If (h_index < 1 Or h_index > n_h) Then Exit Property
+' RETURNS
+    HeadingName = v_headings(h_index)
+End Property
+
+Public Property Get HeadingIndex(ByVal h_search As String, Optional ID_in_searchstr As Boolean = False) As Long
+' FUNCTION
+    ' Get index of h_search within v_headings, if it exists
+' ARGUMENTS
+    ' String h_search - heading to search for
+    ' Boolean ID_in_searchstr - is index in h_search instead of heading name?
+' VARIABLE DECLARATION
+    Dim n_h As Long
+    Dim h_i As Long
+' ARGUMENT VALIDATION
+    If h_search = "" Then Exit Property
+    If Not ExistsHeading(h_search, ID_in_searchstr) Then Exit Property
+' VARIABLE INSTANTIATION
+    n_h = nHeadings
+' METHODS
+    If ID_in_searchstr Then
+        h_i = CLng(h_search)
+        If (h_i < 1 Or h_i > n_h) Then Exit Property
+        HeadingIndex = h_i
+    Else
+        For h_i = 1 To n_h
+            If (v_headings(h_i) = h_search) Then
+                HeadingIndex = h_i
+                Exit Property
+            End If
+        Next
+    End If
+End Property
+
+Public Property Get ColumnID(ByVal h_search As String, Optional ID_in_searchstr As Boolean = False) As Long
+' FUNCTION
+    ' Get index of column containing h_search, if it exists within v_headings
+' ARGUMENTS
+    ' String h_search - heading to search for
+    ' Boolean ID_in_searchstr - is index in h_search instead of heading name?
+' VARIABLE DECLARATION
+    Dim n_h As Long
+    Dim h_i As Long
+' ARGUMENT VALIDATION
+    If h_search = "" Then Exit Property
+    If Not ExistsHeading(h_search, ID_in_searchstr) Then Exit Property
+' VARIABLE INSTANTIATION
+    n_h = nHeadings
+' METHODS
+    If ID_in_searchstr Then
+        h_i = CLng(h_search)
+        If (h_i < 1 Or h_i > n_h) Then Exit Property
+        ColumnID = v_col_IDs(CLng(h_search))
+    Else
+        For h_i = 1 To n_h
+            If (v_headings(h_i) = h_search) Then
+                ColumnID = v_col_IDs(h_i)
+                Exit Property
+            End If
+        Next
+    End If
+End Property
+
+Public Property Get SearchID() As Long
+' FUNCTION
+    ' Get index of search row / column
+' METHODS
+    If v_dir = ColumnHeaders Then
+        SearchID = v_col_search
+    Else
+        SearchID = v_row_search
+    End If
+End Property
+
+Public Property Get ColumnMin() As Long
+    ColumnMin = v_col_min
+End Property
+Public Property Get ColumnMax() As Long
+    ColumnMax = v_col_max
+End Property
+Public Property Get ColumnSearch() As Long
+    ColumnSearch = v_col_search
+End Property
+Public Property Let ColumnSearch(ByVal vNew As Long)
+    If Not valid_coordinate(1, vNew) Then
+        MsgBox "Error: Invalid new search column index"
+        Exit Property
+    End If
+    If vNew < v_col_min And v_dir = ColumnHeaders Then v_col_min = vNew
+    If vNew > v_col_max And v_dir = ColumnHeaders Then v_col_max = vNew
+    If vNew > v_col_min And v_dir = RowHeaders Then v_col_min = vNew + 1
+    v_col_search = vNew
+End Property
+
+Public Property Get RowMin() As Long
+    RowMin = v_row_min
+End Property
+Public Property Get RowMax() As Long
+    RowMax = v_row_max
+End Property
+Public Property Get RowSearch() As Long
+    RowSearch = v_row_search
+End Property
+Public Property Let RowSearch(ByVal vNew As Long)
+    If Not valid_coordinate(vNew, 1) Then
+        MsgBox "Error: Invalid new search column index"
+        Exit Property
+    End If
+    If vNew < v_row_min And v_dir = RowHeaders Then v_row_min = vNew
+    If vNew > v_row_max And v_dir = RowHeaders Then v_row_max = vNew
+    If vNew > v_row_min And v_dir = ColumnHeaders Then v_row_min = vNew + 1
+    v_row_search = vNew
+End Property
+
+Public Property Get Orient() As orientation
+    Orient = v_dir
+End Property
+
+Public Property Get GapMax() As Long
+    GapMax = v_gap_max
+End Property
+
+
+' METHODS
+Public Sub Init(ByRef ws As Worksheet, ByVal name As String, ByRef headings() As String, Optional Orient As orientation = orientation.ColumnHeaders, Optional search_col As Long = 1, Optional search_col_is_heading_index As Boolean = False, Optional search_row As Long = 1, Optional search_row_is_heading_index As Boolean = False, Optional col_min As Long = 1, Optional col_max As Long = 0, Optional row_min As Long = 2, Optional row_max As Long = 0, Optional gap_max As Long = 1, Optional mutable_headings As Boolean = False)
+' FUNCTION
+    ' Instantiate worksheet container
+' ARGUMENTS
+    ' Worksheet ws
+    ' String name
+    ' String Array headings
+    ' orientation Orient
+    ' Long search_col
+    ' Boolean search_col_is_heading_index
+    ' Long search_row
+    ' Boolean search_row_is_heading_index
+    ' Long col_min
+    ' Long col_max
+    ' Long row_min
+    ' Long row_max
+    ' Long gap_max
+    ' Boolean mutable_headings - can headings be over-written?
+' PROCESSING ACCELERATION
+' CONSTANTS
+    Const uni_col_max As Long = 16384
+    Const uni_row_max As Long = 1048576
+' VARIABLE DECLARATION
+    If ws Is Nothing Then Exit Sub
+    Erase v_data
+    Dim my_data() As Variant
+    Dim col_min_str As String
+    Dim col_max_str As String
+    Dim col_search_str As String
+    Dim n_h As Long
+    Dim ws_data_in() As Variant
+    Dim temp_col_min As String
+    Dim temp_col_max As String
+' ARGUMENT VALIDATION
+' VARIABLE INSTANTIATION
+    If (Orient = ColumnHeaders) Then
+        v_col_search = min_Long(max_Long(1, search_col), uni_col_max)
+        v_row_search = min_Long(max_Long(1, search_row), uni_row_max - 1)
+        v_col_min = min_Long(max_Long(1, col_min), uni_col_max - 1)
+        v_row_min = min_Long(max_Long(1 + v_row_search, row_min), uni_row_max)
+    Else
+        v_col_search = min_Long(max_Long(1, search_col), uni_col_max - 1)
+        v_row_search = min_Long(max_Long(1, search_row), uni_row_max)
+        v_col_min = min_Long(max_Long(1 + v_col_search, col_min), uni_col_max)
+        v_row_min = min_Long(max_Long(1, row_min), uni_row_max - 1)
+    End If
+    col_min_str = get_col_str(v_col_min)
+    n_h = SizeArrayDim_String(headings)
+' METHODS
+    Set v_ws = ws
+    v_name = name
+    ' Dimensions
+    If (Orient = ColumnHeaders) Then
+        If (col_max < v_col_min) Then
+            v_col_max = last_filled_cell(Range_1D_String(ws, Range_String(1, 0, v_row_search, v_row_search)), v_col_min, -1, gap_max) ' ws.Range("A" & CStr(v_row_search) & ":XFD" & CStr(v_row_search)).Value,
+            If v_col_max = v_col_min And IsEmpty(ws.Cells(v_row_search, v_col_max)) Then v_col_max = v_col_search
+        Else
+            v_col_max = min_Long(col_max, uni_col_max)
+        End If
+    ' Headings + Column IDs
+        If n_h > 0 Then
+            v_headings = headings
+            GetColIDs
+            If (search_col_is_heading_index And v_col_search <= n_h) Then
+                If (v_col_IDs(v_col_search) > 0) Then v_col_search = v_col_IDs(v_col_search)
+            End If
+        End If
+        If (row_max < v_row_min) Then
+            v_row_max = last_filled_cell(Range_1D_String(ws, Range_String(v_col_search + v_col_min - 1, v_col_search + v_col_min - 1, 1, 0)), v_row_min, -1, gap_max)
+            If v_row_max = v_row_min And IsEmpty(ws.Cells(v_row_max, v_col_search + v_col_min - 1)) Then v_row_max = v_row_search
+        Else
+            v_row_max = min_Long(v_row_max, uni_row_max)
+        End If
+    ' Get data
+        my_data = ws.Range(Range_String(v_col_min, v_col_max, v_row_min, max_Long(v_row_max, v_row_min))).value
+    Else
+        If (row_max < v_row_min) Then
+            v_row_max = last_filled_cell(Range_1D_String(ws, Range_String(1, 0, v_row_search + v_row_min - 1, v_row_search + v_row_min - 1)), v_row_min, -1, gap_max)
+            If v_row_max = v_row_min And IsEmpty(ws.Cells(v_row_max, v_col_search)) Then v_row_max = v_row_search
+        Else
+            v_row_max = min_Long(v_row_max, uni_row_max)
+        End If
+    ' Headings + Column IDs
+        If n_h > 0 Then
+            v_headings = headings
+            GetColIDs
+            If (search_row_is_heading_index And v_row_search <= n_h) Then
+                If (v_col_IDs(v_row_search) > 0) Then v_row_search = v_col_IDs(v_row_search)
+            End If
+        End If
+        If (col_max < v_col_min) Then
+            v_col_max = last_filled_cell(Range_1D_String(ws, Range_String(1, 0, v_row_search, v_row_search)), v_col_min, -1, gap_max) ' ws.Range("A" & CStr(v_row_search) & ":XFD" & CStr(v_row_search)).Value,
+            If v_col_max = v_col_min And IsEmpty(ws.Cells(v_row_search, v_col_max)) Then v_col_max = v_col_search
+        Else
+            v_col_max = min_Long(col_max, uni_col_max)
+        End If
+    ' Get data
+        my_data = ws.Range(Range_String(v_col_min, max_Long(v_col_max, v_col_min), v_row_min, v_row_max)).value
+    End If
+' RETURNS
+    convert_2D_Variant_2_String my_data, v_data
+    v_mutable_headings = mutable_headings
+    v_gap_max = gap_max
+End Sub
+
+Private Sub GetColIDs()
+' FUNCTION
+    ' Find first instance of each of colnames within row RowSearch of ws
+' VARIABLE DECLARATION
+    Dim NHeading As Long
+    Dim Search_S As String
+    Dim iCol As Long
+    Dim ColName As String
+    Dim Outs() As Long
+    Dim Temps() As String
+    Dim iFail As Long
+    Dim fail_S As String
+' VARIABLE INSTANTIATION
+    NHeading = nHeadings
+    ReDim v_col_IDs(NHeading)
+    If (v_dir = ColumnHeaders) Then
+        ' Temps = v_ws.Range(Range_String(v_col_min, v_col_max, v_row_search, v_row_search)).value
+        Temps = Range_1D_String(v_ws, Range_String(v_col_min, v_col_max, v_row_search, v_row_search))
+    Else
+        ' Temps = v_ws.Range(Range_String(v_col_search, v_col_search, v_row_min, v_row_max)).value
+        Temps = Range_1D_String(v_ws, Range_String(v_col_min, v_col_max, v_row_search, v_row_search))
+    End If
+    iFail = 0
+' METHODS
+    For iCol = 1 To NHeading
+        ColName = v_headings(iCol)
+        If Not ColName = "" Then
+            v_col_IDs(iCol) = match_String(ColName, Temps)
+            If v_col_IDs(iCol) < 1 Then
+                iFail = iFail + 1
+                If iFail > 1 Then
+                    fail_S = fail_S & ", " & ColName
+                Else
+                    fail_S = ColName
+                End If
+            End If
+        Else
+            v_col_IDs(iCol) = 0
+        End If
+    Next
+' RETURNS
+    If iFail > 0 Then
+        MsgBox "Error: The below headings were not found on Worksheet " & v_name & vbCrLf & fail_S
+    End If
+End Sub
+
+Public Sub ExportLocalData2WS()
+' FUNCTION
+    ' Export v_data to v_ws
+' METHODS
+    If v_dir = ColumnHeaders Then
+        v_ws.Range(Range_String(v_col_min, v_col_max, v_row_min, max_Long(v_row_max, v_row_min))).value = v_data
+    Else
+        v_ws.Range(Range_String(v_col_min, max_Long(v_col_max, v_col_min), v_row_min, v_row_max)).value = v_data
+    End If
+End Sub
+
+Public Sub AddCellComment(ByVal row As Long, ByVal col As Long, ByVal mycomment As String, Optional row_abs_not_rel As Boolean = False, Optional col_abs_not_rel As Boolean = False)
+' FUNCTION
+    ' Add comment to cell
+' ARGUMENTS
+    ' Long row
+    ' Long col - cell index
+    ' String mycomment
+    ' Optional Boolean row_abs_not_rel
+    ' Optional Boolean col_abs_not_rel - positioning on worksheet relative to v_data table
+' METHODS
+    v_ws.Range(Range_String(col, col, row, row)).AddComment mycomment
+End Sub
+
+Public Sub ResizeLocalAuto(Optional replace_local_data As Boolean = True)
+' FUNCTION
+    ' Find table size from Worksheet
+' PROCESSING ACCELERATION
+    ' Disable automatic spreadsheet calculation - prevents refreshing of whole ws on each cell entry
+    Application.Calculation = xlCalculationManual
+    ' Disable screen updating
+    Application.ScreenUpdating = False
+' CONSTANTS
+    Const uni_col_max As Long = 16384
+    Const uni_row_max As Long = 1048576
+' VARIABLE DECLARATION
+    Dim my_data() As Variant
+' METHODS
+    If (Orient = ColumnHeaders) Then
+        v_row_max = last_filled_cell(Range_1D_String(v_ws, Range_String(v_col_search, v_col_search, 1, 0)), v_row_min, -1, v_gap_max)
+        If v_row_max = v_row_min And IsEmpty(v_ws.Cells(v_row_max, v_col_search)) Then v_row_max = v_row_search
+    ' Get data
+        my_data = v_ws.Range(Range_String(v_col_min, v_col_max, v_row_min, max_Long(v_row_max, v_row_min))).value
+    Else
+        v_col_max = last_filled_cell(Range_1D_String(v_ws, Range_String(1, 0, v_row_search, v_row_search)), v_col_min, -1, v_gap_max) ' ws.Range("A" & CStr(v_row_search) & ":XFD" & CStr(v_row_search)).Value,
+        If v_col_max = v_col_min And IsEmpty(v_ws.Cells(v_row_search, v_col_max)) Then v_col_max = v_col_search
+    ' Get data
+        my_data = v_ws.Range(Range_String(v_col_min, max_Long(v_col_max, v_col_min), v_row_min, v_row_max)).value
+    End If
+' RETURNS
+    If replace_local_data Then
+        Erase v_data
+        convert_2D_Variant_2_String my_data, v_data
+    End If
+' PROCESSING DECELARATION
+    ' Enable automatic spreadsheet calculation - prevents refreshing of whole ws on each cell entry
+    Application.Calculation = xlCalculationAutomatic
+    ' Enable screen updating
+    Application.ScreenUpdating = True
+End Sub
+
+
+Public Sub ResizeLocal(ByVal col_min As Long, ByVal col_max As Long, ByVal row_min As Long, ByVal row_max As Long, Optional clear_data As Boolean = False)
+' FUNCTION
+    ' Resize local copy of ws table data
+' ARGUMENTS
+    ' Long col_min
+    ' Long col_max
+    ' Long row_min
+    ' Long row_max
+    ' Optional Boolean clear_data
+' ARGUMENT VALIDATION
+    If col_max < col_min Or row_max < row_min Or (Not valid_coordinate(row_min, col_min)) Or (Not valid_coordinate(row_max, col_max)) Then
+        MsgBox "Error: Invalid new local data dimensions." & vbCrLf & error_msg(col_min, "col_min", "Long", "?") & vbCrLf & error_msg(col_max, "col_max", "Long", "?") & vbCrLf & error_msg(row_min, "row_min", "Long", "?") & vbCrLf & error_msg(row_max, "row_max", "Long", "?")
+        Exit Sub
+    End If
+    If col_min = v_col_min And col_max = v_col_max And row_min = v_row_min And row_max = v_row_max Then
+        Debug.Print "No change required to local data dimensions."
+        Exit Sub
+    End If
+' METHODS
+    If clear_data Then
+        v_col_min = col_min
+        v_col_max = col_max
+        v_row_min = row_min
+        v_row_max = row_max
+        ClearData
+    Else
+        v_col_min = col_min
+        v_col_max = col_max
+        ReDimPreserve_String v_data, 2, v_col_max - v_col_min + 1, 2
+        v_row_min = row_min
+        v_row_max = row_max
+        ReDimPreserve_String v_data, 1, v_row_max - v_row_min + 1, 2
+    End If
+End Sub
+
+
+Public Function Match(ByVal v_search As String, Optional array_ID As Long = -1, Optional minimum As Long = 1, Optional maximum As Long = -1, Optional dir_move As dir_traverse = dir_traverse.FORWARDS) As Long
+' FUNCTION
+    ' Find match of v_search in local data and return index
+' ARGUMENTS
+    ' String v_search
+    ' Long array_ID
+    ' Long minimum
+    ' Long maximum
+    ' dir_traverse dir_move
+' CONSTANTS
+    ' Const RowMaxUniversal As Long = 1048576
+    ' Const ColMaxUniversal As Long = 16384
+' VARIABLE DECLARATION
+    Dim i As Long
+    Dim di As Long
+    Dim RowMaxUniversal As Long
+    Dim ColMaxUniversal As Long
+' ARGUMENT VALIDATION
+    Match = -1
+' VARIABLE INSTANTIATION
+    RowMaxUniversal = SizeArrayDim_String(v_data, 1) + v_row_min - 1
+    ColMaxUniversal = SizeArrayDim_String(v_data, 2) + v_col_min - 1
+    If v_dir = ColumnHeaders Then
+        maximum = min_Long(RowMaxUniversal - v_row_min + 1, maximum)
+        If maximum < 1 Then maximum = RowMaxUniversal - v_row_min + 1
+        minimum = max_Long(1, min_Long(minimum, maximum))
+        If Not valid_coordinate(minimum, 1) Then minimum = 1
+        If Not valid_coordinate(maximum, 1) Then maximum = v_row_max - v_row_min + 1
+        If Not valid_coordinate(1, array_ID) Then array_ID = v_col_search
+    Else
+        maximum = min_Long(ColMaxUniversal - v_col_min + 1, maximum)
+        If maximum < 1 Then maximum = ColMaxUniversal - v_col_min + 1
+        minimum = max_Long(1, min_Long(minimum, maximum))
+        If Not valid_coordinate(1, minimum) Then minimum = 1
+        If Not valid_coordinate(1, maximum) Then maximum = v_col_max - v_col_min + 1
+        If Not valid_coordinate(array_ID, 1) Then array_ID = v_row_search
+    End If
+    If maximum < minimum Then ' not possible
+        MsgBox "Error: Invalid minimum (" & CStr(minimum) & ") and maximum (" & CStr(maximum) & ") positions."
+        Exit Function
+    End If
+    If dir_move = BACKWARDS Then
+        i = minimum
+        minimum = maximum
+        maximum = i
+        di = -1
+    Else
+        di = 1
+    End If
+' METHODS
+    For i = minimum To maximum Step di
+        If v_dir = ColumnHeaders Then
+            If v_data(i, array_ID) = v_search Then
+                Match = i
+                Exit For
+            End If
+        Else
+            If v_data(array_ID, i) = v_search Then
+                Match = i
+                Exit For
+            End If
+        End If
+    Next
+End Function
+
+
+Public Function Match_F(ByVal v_search As String, ByVal function_name As String, Optional array_ID As Long = -1, Optional minimum As Long = 1, Optional maximum As Long = -1, Optional dir_move As dir_traverse = dir_traverse.FORWARDS) As Long
+' FUNCTION
+    ' Find match of v_search in local data and return index
+' ARGUMENTS
+    ' String v_search
+    ' String function_name - name of function which takes single argument of cell data
+    ' Long array_ID
+    ' Long minimum
+    ' Long maximum
+    ' dir_traverse dir_move
+' VARIABLE DECLARATION
+    Dim i As Long
+    Dim di As Long
+' ARGUMENT VALIDATION
+    Match_F = -1
+' VARIABLE INSTANTIATION
+    i = max_Long(minimum, maximum)
+    minimum = max_Long(1, min_Long(minimum, maximum))
+    If v_dir = ColumnHeaders Then
+        maximum = min_Long(1048576, i)
+        If Not valid_coordinate(1, minimum) Then minimum = v_row_min
+        If Not valid_coordinate(1, maximum) Then maximum = v_row_max
+        If Not valid_coordinate(1, array_ID) Then array_ID = v_row_search
+    Else
+        maximum = min_Long(16384, i)
+        If Not valid_coordinate(minimum, 1) Then minimum = v_col_min
+        If Not valid_coordinate(maximum, 1) Then maximum = v_col_max
+        If Not valid_coordinate(array_ID, 1) Then array_ID = v_col_search
+    End If
+    If maximum < minimum Then
+        MsgBox "Error: Invalid minimum (" & CStr(minimum) & ") and maximum (" & CStr(maximum) & ") positions."
+        Exit Function
+    End If
+    If dir_move = BACKWARDS Then
+        i = minimum
+        minimum = maximum
+        maximum = i
+        di = -1
+    Else
+        di = 1
+    End If
+' METHODS
+    For i = minimum To maximum Step di
+        If v_dir = ColumnHeaders Then
+            If CStr(Application.Run(function_name, v_data(i, array_ID))) = v_search Then
+                Match_F = i
+                Exit For
+            End If
+        Else
+            If CStr(Application.Run(function_name, v_data(array_ID, i))) = v_search Then
+                Match_F = i
+                Exit For
+            End If
+        End If
+    Next
+End Function
+
+
+Public Function ExistsHeading(ByVal search_heading As String, Optional ID_in_str As Boolean = False) As Boolean
+' FUNCTION
+    ' Does search_heading exist in v_headings?
+' ARGUMENTS
+    ' String search_heading
+    ' Boolean ID_in_str - is search_heading a heading index instead of name?
+' VARIABLE DECLARATION
+    Dim h_n As Long
+    Dim h_i As Long
+    Dim ID As String
+' ARGUMENT VALIDATION
+    ExistsHeading = False
+    If search_heading = "" Then Exit Function
+' VARIABLE INSTANTIATION
+    h_n = nHeadings
+' METHODS
+    If ID_in_str Then
+        If Not is_numeric(search_heading) Then Exit Function
+        ID = CLng(search_heading)
+        If ID < 1 Or ID > h_n Then Exit Function
+        ExistsHeading = True
+        Exit Function
+    End If
+    For h_i = 1 To h_n
+        If v_headings(h_i) = search_heading Then
+            ExistsHeading = True
+            Exit Function
+        End If
+    Next
+End Function
+
+
+Public Sub ClearData()
+' FUNCTION
+    ' Clear contents of local copy of ws data but keep dimensions
+' METHODS
+    ReDim v_data(v_row_max - v_row_min + 1, v_col_max - v_col_min + 1)
+End Sub
+
+
+Public Function LastFilledCell(Optional search_ID As Long = -1, Optional start As Long = -1, Optional gap_max As Long = -1, Optional Orient As orientation, Optional i_max As Long = -1, Optional dir_move As dir_traverse) As Long
+' FUNCTION
+    ' Identify index of last filled cell in column or row from start in v_ws
+' ARGUMENTS
+    ' Optional Long search_ID
+    ' Optional Long start
+    ' Optional Long gap_max
+    ' Optional orientation orient
+    ' Optional Long i_max
+    ' Optional dir_traverse dir_move
+' CONSTANTS
+    Const uni_row_max As Long = 1048576
+    Const uni_col_max As Long = 16384
+' VARIABLE DECLARATION
+    Dim found_last As Boolean
+    Dim temp As Variant
+    Dim gap_n As Long
+    Dim i As Long
+' ARGUMENT VALIDATION
+    If Orient = ColumnHeaders Then
+        If i_max < 1 Then i_max = uni_row_max
+        i_max = min_Long(max_Long(1, i_max), uni_row_max)
+        If search_ID < 1 Then
+            search_ID = v_col_search
+        Else
+            search_ID = min_Long(max_Long(1, search_ID), uni_col_max)
+        End If
+        gap_max = min_Long(max_Long(1, gap_max), i_max - 1)
+        If start = -1 Then
+            start = v_row_min
+        Else
+            start = min_Long(max_Long(1, v_row_min), max_Long(i_max - gap_max, 1))
+        End If
+    Else
+        If i_max < 1 Then i_max = uni_col_max
+        i_max = min_Long(max_Long(1, i_max), uni_col_max)
+        If search_ID < 1 Then
+            search_ID = v_row_search
+        Else
+            search_ID = min_Long(max_Long(1, search_ID), uni_row_max)
+        End If
+        gap_max = min_Long(max_Long(1, gap_max), i_max - 1)
+        If start = -1 Then
+            start = v_row_min
+        Else
+            start = min_Long(max_Long(1, v_row_min), max_Long(i_max - gap_max, 1))
+        End If
+    End If
+' VARIABLE INSTANTIATION
+    found_last = False
+    If dir_move = FORWARDS Then
+        i = start - 1
+    Else
+        i = i_max + 1
+    End If
+' METHODS
+    Do While Not found_last
+        i = i + dir_move
+        If Orient = ColumnHeaders Then
+            temp = Me.Cell(i, search_ID).value
+        Else
+            temp = Me.Cell(search_ID, i).value
+        End If
+        If (dir_move = FORWARDS And i = start) Or (dir_move = FORWARDS And i = start) Then
+            found_last = True
+        ElseIf IsEmpty(temp) Then
+            gap_n = gap_n + 1
+        Else
+            gap_n = 0
+        End If
+        If gap_n > gap_max Then found_last = True
+    Loop
+' RETURNS
+    LastFilledCell = i - gap_n * dir_move
+End Function

src/WS_Relation.cls

@@ -0,0 +1,276 @@
+' Author: Edward Middleton-Smith
+' Precision And Research Technology Systems Limited
+
+
+' MODULE INITIALISATION
+' Set array start index to 1 to match spreadsheet indices
+Option Base 1
+' Forced Variable Declaration
+Option Explicit
+
+
+
+
+' PROPERTY DECLARATION
+Private v_wss As Collection
+Private v_N_h As Long
+Private v_name As String
+
+
+' PROPERTY METHODS
+Public Property Get nSheets() As Long
+    nSheets = CountWorksheets
+End Property
+
+Public Property Get nHeadings() As Long
+    nHeadings = v_N_h
+End Property
+
+Public Property Get wsc(ByVal sheet_name As String, Optional ID_in_name As Boolean = False) As ws_access
+' FUNCTION
+    ' Get Worksheet Container object by name or ID
+' ARGUMENTS
+    ' String sheet_name
+    ' Boolean ID_in_name
+' VARIABLE DECLARATION
+    Dim sheet_ID As Long
+    Dim n_ws As Long
+    Dim w_i As Long
+    Dim wsc_temp As ws_access
+' VARIABLE INSTANTIATION
+    n_ws = CountWorksheets
+' METHODS
+    If sheet_name = "" Then Exit Property
+    If ID_in_name Then
+        If Not is_numeric(sheet_name) Then Exit Property
+        sheet_ID = CLng(sheet_name)
+        If (sheet_ID < 1 Or sheet_ID > n_ws) Then
+            Set wsc = v_wss.Item(sheet_ID)
+            Exit Property
+        End If
+    End If
+    For w_i = 1 To n_ws
+        Set wsc_temp = v_wss.Item(w_i)
+        If wsc_temp.name = sheet_name Then
+            Set wsc = wsc_temp
+            Exit Property
+        End If
+    Next
+End Property
+
+Public Property Get name() As String
+    name = v_name
+End Property
+Public Property Let name(ByVal new_name As String)
+    v_name = new_name
+End Property
+
+
+' METHODS
+Public Function AddWSC(ByRef wsc As ws_access, Optional suppress_console_outputs As Boolean = False) As Boolean
+' FUNCTION
+    ' Get Workheet Container object by name or ID
+' ARGUMENTS
+    ' ws_access wsc
+' VARIABLE DECLARATION
+    Dim n_h As Long
+    Dim n_ws As Long
+' ARGUMENT VALIDATION
+    AddWSC = False
+    If wsc Is Nothing Then Exit Function
+' VARIABLE INSTANTIATION
+    n_h = wsc.nHeadings
+    n_ws = CountWorksheets
+' METHODS
+    If n_ws = 0 Then
+        v_N_h = n_h
+        Set v_wss = New Collection
+        v_wss.Add wsc
+        If Not suppress_console_outputs Then Debug.Print "Worksheet Container " & wsc.name & " added to Worksheet Relation " & v_name & "."
+    Else
+        If v_N_h = n_h Then
+            v_wss.Add wsc
+            If Not suppress_console_outputs Then Debug.Print "Worksheet Container " & wsc.name & " added to Worksheet Relation " & v_name & "."
+        Else
+            MsgBox "Error: Unable to add Worksheet Container " & wsc.name & " to Worksheet Relation " & v_name & "." & vbCrLf & _
+                CStr(v_N_h) & " headings in relation." & vbCrLf & _
+                CStr(n_h) & " headings in container."
+            Exit Function
+        End If
+    End If
+' RETURNS
+    AddWSC = True
+End Function
+
+Private Function CountWorksheets() As Long
+    If v_wss Is Nothing Then
+        CountWorksheets = 0
+    Else
+        CountWorksheets = v_wss.count
+    End If
+End Function
+
+Public Sub Populate(Optional recipient_wsc As String = "1", Optional recipient_ID_in_str As Boolean = True, Optional provider_wsc As String = "2", Optional provider_ID_in_str As Boolean = True, Optional write_empties_only As Boolean = False, Optional export_2_ws As Boolean = True)
+' FUNCTION
+    ' Populate recipient wsc with data for each record by look up in provider wsc
+' ARGUMENTS
+    ' Optional String recipient_wsc
+    ' Optional Boolean recipient_ID_in_str
+    ' Optional String provider_wsc
+    ' Optional Boolean provider_ID_in_str - ID instead of wsc name?
+' VARIABLE DECLARATION
+    Dim n_ws As Long
+    Dim wsc_recipient As ws_access
+    Dim wsc_provider As ws_access
+    Dim h_i As Long
+    Dim col_recipient As Long
+    Dim col_provider As Long
+    Dim row_recipient As Long
+    Dim row_provider As Long
+' ARGUMENT VALIDATION
+    n_ws = CountWorksheets
+    If (n_ws < 2 Or (recipient_wsc = provider_wsc And recipient_ID_in_str = provider_ID_in_str) Or Not ExistsWSC(recipient_wsc, recipient_ID_in_str) Or Not ExistsWSC(recipient_wsc, recipient_ID_in_str)) Then
+        MsgBox "Error: Unable to populate Worksheet Container " & recipient_wsc & " with " & provider_wsc
+        Exit Sub
+    End If
+' VARIABLE INSTANTIATION
+    Set wsc_recipient = v_wss.Item(IndexWSC(recipient_wsc, recipient_ID_in_str))
+    Set wsc_provider = v_wss.Item(IndexWSC(provider_wsc, provider_ID_in_str))
+' METHODS
+    If wsc_recipient.Orient = ColumnHeaders Then
+        For row_recipient = 1 To wsc_recipient.RowMax - wsc_recipient.RowMin + 1
+            row_provider = wsc_provider.Match(wsc_recipient.GetCellDataLocal(row_recipient, wsc_recipient.ColumnSearch))
+            If row_provider > 0 Then
+                For h_i = 1 To v_N_h
+                    col_recipient = wsc_recipient.ColumnID(CStr(h_i), True)
+                    col_provider = wsc_provider.ColumnID(CStr(h_i), True)
+                    If col_provider > 0 And col_recipient > 0 Then
+                        If col_recipient <> wsc_recipient.ColumnSearch Then
+                            If wsc_provider.Orient = ColumnHeaders Then
+                                wsc_recipient.SetCellDataLocal row_recipient, col_recipient, wsc_provider.GetCellDataLocal(row_provider, col_provider)
+                            Else
+                                wsc_recipient.SetCellDataLocal row_recipient, col_recipient, wsc_provider.GetCellDataLocal(col_provider, row_provider)
+                            End If
+                        End If
+                    End If
+                Next
+            Else
+                Debug.Print "Customer not found:" & vbCrLf & "Customer reference = " & wsc_recipient.GetCellDataLocal(row_recipient, wsc_recipient.ColumnSearch) & vbCrLf & "Row = " & CStr(row_recipient + wsc_recipient.RowMin - 1)
+            End If
+        Next
+    Else
+        For row_recipient = 1 To wsc_recipient.ColumnMax - wsc_recipient.ColumnMin + 1
+            row_provider = wsc_provider.Match(wsc_recipient.GetCellDataLocal(wsc_recipient.RowSearch, row_recipient))
+            If row_provider > 0 Then
+                For h_i = 1 To v_N_h
+                    col_recipient = wsc_recipient.ColumnID(CStr(h_i), True)
+                    col_provider = wsc_provider.ColumnID(CStr(h_i), True)
+                    If col_provider > 0 And col_recipient > 0 Then
+                        If (wsc_recipient.Orient = ColumnHeaders And col_recipient <> wsc_recipient.ColumnSearch) Then
+                            If wsc_provider.Orient = ColumnHeaders Then
+                                wsc_recipient.SetCellDataLocal col_recipient, row_recipient, wsc_provider.GetCellDataLocal(row_provider, col_provider)
+                            Else
+                                wsc_recipient.SetCellDataLocal col_recipient, row_recipient, wsc_provider.GetCellDataLocal(col_provider, row_provider)
+                            End If
+                        End If
+                    End If
+                Next
+            Else
+                Debug.Print "Customer not found:" & vbCrLf & "Customer reference = " & wsc_recipient.GetCellDataLocal(wsc_recipient.RowSearch, row_recipient) & vbCrLf & "Column = " & CStr(row_recipient + wsc_recipient.ColumnMin - 1)
+            End If
+        Next
+    End If
+' RETURNS
+    If export_2_ws Then wsc_recipient.ExportLocalData2WS
+End Sub
+
+Public Function ExistsWSC(ByVal wsc_name As String, Optional ID_in_str As Boolean = True) As Boolean
+' FUNCTION
+    ' Identify is Worksheet Container exists in relationship
+' ARGUMENTS
+    ' String wsc_name
+    ' Optional Boolean ID_in_str - ID as String instead of name?
+' VARIABLE DECLARATION
+    Dim n_ws As Long
+    Dim w_i As Long
+    Dim ID As Long
+' VARIABLE INSTANTIATION
+    n_ws = CountWorksheets
+    ExistsWSC = False
+' ARGUMENT VALIDATION
+    If wsc_name = "" Then Exit Function
+' METHODS
+    If ID_in_str Then
+        If Not is_numeric(wsc_name) Then Exit Function
+        ID = CLng(wsc_name)
+        If Not (ID > 0 And ID <= n_ws) Then Exit Function
+        ExistsWSC = True
+        Exit Function
+    End If
+    For w_i = 1 To n_ws
+        If v_wss.Item(w_i).name = wsc_name Then
+            ExistsWSC = True
+            Exit Function
+        End If
+    Next
+' RETURNS
+    MsgBox "Error: Worksheet Container " & wsc_name & " not found in relation."
+End Function
+
+Public Function IndexWSC(ByVal wsc_name As String, Optional ID_in_str As Boolean = True) As Long
+' FUNCTION
+    ' Get index for Worksheet Container within relationship
+' ARGUMENTS
+    ' String wsc_name
+    ' Optional Boolean ID_in_str - ID as String instead of name?
+' VARIABLE DECLARATION
+    Dim n_ws As Long
+    Dim w_i As Long
+' VARIABLE INSTANTIATION
+    n_ws = CountWorksheets
+    IndexWSC = False
+' ARGUMENT VALIDATION
+    If Not ExistsWSC(wsc_name, ID_in_str) Then Exit Function
+' METHODS
+    If ID_in_str Then
+        IndexWSC = CLng(wsc_name)
+    Else
+        For w_i = 1 To n_ws
+            If v_wss.Item(w_i).name = wsc_name Then
+                IndexWSC = w_i
+                Exit For
+            End If
+        Next
+    End If
+End Function
+
+Public Function SafeOpenWB(ByVal pathWB As String) As Workbook
+' FUNCTION
+    ' Open Workbook if not already open
+' ARGUMENTS
+    ' String pathWB
+' VARIABLE DECLARATION
+    Dim wb As Workbook
+    Dim nameWB As String
+    Dim nWB As Long
+    Dim iWB As Long
+' VARIABLE INSTANTIATION
+    nameWB = Path2Name(pathWB)
+    nWB = Workbooks.count
+' ARGUMENT VALIDATION
+    If nameWB = "" Then
+        MsgBox "Error: Invalid workbook path"
+        Exit Function
+    End If
+' METHODS
+    For iWB = 1 To nWB
+        Set wb = Workbooks.Item(iWB)
+        If wb.name = nameWB Then
+            Set SafeOpenWB = wb
+            Exit Function
+        End If
+    Next
+' RETURNS
+    Set SafeOpenWB = Workbooks.Open(pathWB)
+End Function
+