Dear " & name & ",
" + +' METHODS + Select Case overdue_status + Case OverdueStatus.OVERDUE: + mail_body = mail_body & "Your account is overdue with a balance of £" & CStr(balance) & ".
"
+ mail_body = mail_body & "Please resolve your balance as soon as possible.
Your account is overdue with a balance of £" & CStr(balance) & ".
"
+ mail_body = mail_body & "Please resolve your balance as soon as possible.
Kind regards,
"
+ mail_body = mail_body & "Lord Edward Middleton-Smith
"
+ mail_body = mail_body & "Director
"
+ 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
diff --git a/src/Matrix_Operations.bas b/src/Matrix_Operations.bas
new file mode 100644
index 0000000..2977351
--- /dev/null
+++ b/src/Matrix_Operations.bas
@@ -0,0 +1,1474 @@
+' 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
+
+
+Sub ReDimPreserve_String(ByRef arr() As String, ByVal dimension As Long, ByVal newbound As Long, ByVal NDim As Long)
+' FUNCTION
+ ' Redimensionalise array without losing data (unless shrinking)
+' ARGUMENTS
+ ' String Array arr
+ ' Long dimension - dimension of arr to change
+ ' Long newbound - new size of dimension
+ ' Long ndim - number of dimensions of arr
+' VARIABLE DECLARATION
+ Dim x() As Long ' Iterables for each dimension
+ Dim N() As Long ' Size of each dimension
+ Dim i As Long
+ Dim j As Long
+ Dim iterate As Boolean
+ Dim Outs() As String
+ Dim Nold() As Long
+ Dim minbound As Long
+' VARIABLE INSTANTIATION
+ ReDim x(NDim)
+ ReDim N(NDim)
+ iterate = True
+' METHODS
+ ' Populate N
+ For i = 1 To NDim
+ x(i) = 1
+ N(i) = SizeArrayDim_String(arr, i)
+ Next
+ Nold = N
+ N(dimension) = newbound
+ minbound = min_Long(newbound, Nold(dimension))
+ ' Redimensionalise outputs
+ Select Case NDim
+ Case 1
+ ReDim Outs(N(1))
+ Case 2
+ ReDim Outs(N(1), N(2))
+ Case 3
+ ReDim Outs(N(1), N(2), N(3))
+ Case 4
+ ReDim Outs(N(1), N(2), N(3), N(4))
+ Case 5
+ ReDim Outs(N(1), N(2), N(3), N(4), N(5))
+ Case Else
+ MsgBox "Too many dimensions"
+ Exit Sub
+ End Select
+ ' Fill values
+ Do While iterate
+ ' Fill value
+ Select Case NDim
+ Case 1
+ Outs(x(1)) = arr(x(1))
+ Case 2
+ Outs(x(1), x(2)) = arr(x(1), x(2))
+ Case 3
+ Outs(x(1), x(2), x(3)) = arr(x(1), x(2), x(3))
+ Case 4
+ Outs(x(1), x(2), x(3), x(4)) = arr(x(1), x(2), x(3), x(4))
+ Case 5
+ Outs(x(1), x(2), x(3), x(4), x(5)) = arr(x(1), x(2), x(3), x(4), x(5))
+ Case Else
+ MsgBox "Too many dimensions"
+ Exit Sub
+ End Select
+ ' Iterate position
+ For i = NDim To 1 Step -1
+ If (i = dimension) Then
+ If (x(dimension) < minbound) Then
+ x(dimension) = x(dimension) + 1
+ If (dimension < NDim) Then
+ For j = dimension + 1 To NDim
+ x(j) = 1
+ Next
+ End If
+ Exit For
+ End If
+ ElseIf (x(i) < N(i)) Then
+ x(i) = x(i) + 1
+ If (i < NDim) Then
+ For j = i + 1 To NDim
+ x(j) = 1
+ Next
+ End If
+ Exit For
+ End If
+ If (i = 1) Then
+ iterate = False
+ End If
+ Next
+ Loop
+' RETURNS
+ arr = Outs
+End Sub
+
+
+Sub ReDimPreserve_Long(ByRef arr() As Long, ByVal dimension As Long, ByVal newbound As Long, ByVal NDim As Long)
+' FUNCTION
+ ' Redimensionalise array without losing data (unless shrinking)
+' ARGUMENTS
+ ' Long Array arr
+ ' Long dimension - dimension of arr to change
+ ' Long newbound - new size of dimension
+ ' Long ndim - number of dimensions of arr
+' VARIABLE DECLARATION
+ Dim x() As Long ' Iterables for each dimension
+ Dim N() As Long ' Size of each dimension
+ Dim i As Long
+ Dim j As Long
+ Dim iterate As Boolean
+ Dim Outs() As Long
+ Dim Nold() As Long
+ Dim minbound As Long
+' VARIABLE INSTANTIATION
+ ReDim x(NDim)
+ ReDim N(NDim)
+ iterate = True
+' METHODS
+ ' Populate N
+ For i = 1 To NDim
+ x(i) = 1
+ N(i) = SizeArrayDim_Long(arr, i)
+ Next
+ Nold = N
+ N(dimension) = newbound
+ minbound = min_Long(newbound, Nold(dimension))
+ ' Redimensionalise outputs
+ Select Case NDim
+ Case 1
+ ReDim Outs(N(1))
+ Case 2
+ ReDim Outs(N(1), N(2))
+ Case 3
+ ReDim Outs(N(1), N(2), N(3))
+ Case 4
+ ReDim Outs(N(1), N(2), N(3), N(4))
+ Case 5
+ ReDim Outs(N(1), N(2), N(3), N(4), N(5))
+ Case Else
+ MsgBox "Too many dimensions"
+ Exit Sub
+ End Select
+ ' Fill values
+ Do While iterate
+ ' Fill value
+ Select Case NDim
+ Case 1
+ Outs(x(1)) = arr(x(1))
+ Case 2
+ Outs(x(1), x(2)) = arr(x(1), x(2))
+ Case 3
+ Outs(x(1), x(2), x(3)) = arr(x(1), x(2), x(3))
+ Case 4
+ Outs(x(1), x(2), x(3), x(4)) = arr(x(1), x(2), x(3), x(4))
+ Case 5
+ Outs(x(1), x(2), x(3), x(4), x(5)) = arr(x(1), x(2), x(3), x(4), x(5))
+ Case Else
+ MsgBox "Too many dimensions"
+ Exit Sub
+ End Select
+ ' Iterate position
+ For i = NDim To 1 Step -1
+ If (i = dimension) Then
+ If (x(dimension) < minbound) Then
+ x(dimension) = x(dimension) + 1
+ If (dimension < NDim) Then
+ For j = dimension + 1 To NDim
+ x(j) = 1
+ Next
+ End If
+ Exit For
+ End If
+ ElseIf (x(i) < N(i)) Then
+ x(i) = x(i) + 1
+ If (i < NDim) Then
+ For j = i + 1 To NDim
+ x(j) = 1
+ Next
+ End If
+ Exit For
+ End If
+ If (i = 1) Then
+ iterate = False
+ End If
+ Next
+ Loop
+' RETURNS
+ arr = Outs
+End Sub
+
+
+Sub ReDimPreserve_Variant(ByRef arr() As Variant, ByVal dimension As Long, ByVal newbound As Long, ByVal NDim As Long)
+' FUNCTION
+ ' Redimensionalise array without losing data (unless shrinking)
+' ARGUMENTS
+ ' Variant Array arr
+ ' Long dimension - dimension of arr to change
+ ' Long newbound - new size of dimension
+ ' Long ndim - number of dimensions of arr
+' VARIABLE DECLARATION
+ Dim x() As Long ' Iterables for each dimension
+ Dim N() As Long ' Size of each dimension
+ Dim i As Long
+ Dim j As Long
+ Dim iterate As Boolean
+ Dim Outs() As Variant
+ Dim Nold() As Long
+ Dim minbound As Long
+' VARIABLE INSTANTIATION
+ ReDim x(NDim)
+ ReDim N(NDim)
+ iterate = True
+' METHODS
+ ' Populate N
+ For i = 1 To NDim
+ x(i) = 1
+ N(i) = SizeArrayDim_Variant(arr, i)
+ Next
+ Nold = N
+ N(dimension) = newbound
+ minbound = min_Long(newbound, Nold(dimension))
+ ' Redimensionalise outputs
+ Select Case NDim
+ Case 1
+ ReDim Outs(N(1))
+ Case 2
+ ReDim Outs(N(1), N(2))
+ Case 3
+ ReDim Outs(N(1), N(2), N(3))
+ Case 4
+ ReDim Outs(N(1), N(2), N(3), N(4))
+ Case 5
+ ReDim Outs(N(1), N(2), N(3), N(4), N(5))
+ Case Else
+ MsgBox "Too many dimensions"
+ Exit Sub
+ End Select
+ ' Fill values
+ Do While iterate
+ ' Fill value
+ Select Case NDim
+ Case 1
+ Outs(x(1)) = arr(x(1))
+ Case 2
+ Outs(x(1), x(2)) = arr(x(1), x(2))
+ Case 3
+ Outs(x(1), x(2), x(3)) = arr(x(1), x(2), x(3))
+ Case 4
+ Outs(x(1), x(2), x(3), x(4)) = arr(x(1), x(2), x(3), x(4))
+ Case 5
+ Outs(x(1), x(2), x(3), x(4), x(5)) = arr(x(1), x(2), x(3), x(4), x(5))
+ Case Else
+ MsgBox "Too many dimensions"
+ Exit Sub
+ End Select
+ ' Iterate position
+ For i = NDim To 1 Step -1
+ If (i = dimension) Then
+ If (x(dimension) < minbound) Then
+ x(dimension) = x(dimension) + 1
+ If (dimension < NDim) Then
+ For j = dimension + 1 To NDim
+ x(j) = 1
+ Next
+ End If
+ Exit For
+ End If
+ ElseIf (x(i) < N(i)) Then
+ x(i) = x(i) + 1
+ If (i < NDim) Then
+ For j = i + 1 To NDim
+ x(j) = 1
+ Next
+ End If
+ Exit For
+ End If
+ If (i = 1) Then
+ iterate = False
+ End If
+ Next
+ Loop
+' RETURNS
+ arr = Outs
+End Sub
+
+
+Function SizeArrayDim_String(ByRef arr() As String, Optional dimension As Long = 1) As Long
+' FUNCTION
+ ' Find size of dimension of arr
+' VARIABLE INSTANTIATION
+ dimension = max_Long(1, dimension)
+' METHODS
+ On Error GoTo errhand
+ If Not ((Not arr) = -1) Then
+ SizeArrayDim_String = UBound(arr, dimension) - LBound(arr, dimension) + 1
+ Else
+ SizeArrayDim_String = 0
+ End If
+ Exit Function
+' ERROR HANDLING
+errhand:
+ SizeArrayDim_String = 0
+End Function
+
+
+Function SizeArrayDim_Long(ByRef arr() As Long, Optional dimension As Long = 1) As Long
+' FUNCTION
+ ' Find size of dimension of arr
+' VARIABLE INSTANTIATION
+ dimension = max_Long(1, dimension)
+' METHODS
+ On Error GoTo errhand
+ If Not ((Not arr) = -1) Then
+ SizeArrayDim_Long = UBound(arr, dimension) - LBound(arr, dimension) + 1
+ Else
+ SizeArrayDim_Long = 0
+ End If
+ Exit Function
+' ERROR HANDLING
+errhand:
+ SizeArrayDim_Long = 0
+End Function
+
+
+Function SizeArrayDim_Variant(ByRef arr() As Variant, Optional dimension As Long = 1) As Long
+' FUNCTION
+ ' Find size of dimension of arr
+' VARIABLE INSTANTIATION
+ dimension = max_Long(1, dimension)
+' METHODS
+ On Error GoTo errhand
+ If Not ((Not arr) = -1) Then
+ SizeArrayDim_Variant = UBound(arr, dimension) - LBound(arr, dimension) + 1
+ Else
+ SizeArrayDim_Variant = 0
+ End If
+ Exit Function
+' ERROR HANDLING
+errhand:
+ SizeArrayDim_Variant = 0
+End Function
+
+
+Function SizeArrayDim_Variant_0(ByVal arr As Variant) As Long
+' FUNCTION
+ ' Find size of dimension of arr
+' METHODS
+ On Error GoTo errhand
+ If Not IsEmpty(arr) Then ' ((Not arr) = -1) Then
+ SizeArrayDim_Variant_0 = UBound(arr) - LBound(arr) + 1
+ Else
+ SizeArrayDim_Variant_0 = 0
+ End If
+ Exit Function
+' ERROR HANDLING
+errhand:
+ SizeArrayDim_Variant_0 = 0
+End Function
+
+
+Function create_1D_mat_Boolean(Optional value As Boolean = False, Optional N As Long = 1) As Boolean()
+' FUNCTION
+ ' Create 1D matrix (array) of size N, type Boolean and value
+' ARGUMENTS
+ ' Boolean value - for each element of array
+ ' Long N - number of elements in array
+' PROCESSING ACCELERATION
+' CONSTANTS
+' VARIABLE DECLARATION
+ Dim Outs() As Boolean
+ Dim i As Long
+' ARGUMENT VALIDATION
+ N = max_Long(1, N)
+' VARIABLE INSTANTIATION
+ ReDim Outs(N)
+' METHODS
+ For i = 1 To N
+ Outs(i) = value
+ Next
+' RETURNS
+ create_1D_mat_Boolean = Outs
+End Function
+
+
+Function create_1D_mat_Long(Optional value As Long = 0, Optional N As Long = 1) As Long()
+' FUNCTION
+ ' Create 1D matrix (array) of size N, type Long and value
+' ARGUMENTS
+ ' Long value - for each element of array
+ ' Long N - number of elements in array
+' PROCESSING ACCELERATION
+' CONSTANTS
+' VARIABLE DECLARATION
+ Dim Outs() As Long
+ Dim i As Long
+' ARGUMENT VALIDATION
+ N = max_Long(1, N)
+' VARIABLE INSTANTIATION
+ ReDim Outs(N)
+' METHODS
+ For i = 1 To N
+ Outs(i) = value
+ Next
+' RETURNS
+ create_1D_mat_Long = Outs
+End Function
+
+
+Function create_1D_mat_String(Optional value As String = False, Optional N As Long = 1) As String()
+' FUNCTION
+ ' Create 1D matrix (array) of size N, type String and value
+' ARGUMENTS
+ ' String value - for each element of array
+ ' Long N - number of elements in array
+' PROCESSING ACCELERATION
+' CONSTANTS
+' VARIABLE DECLARATION
+ Dim Outs() As String
+ Dim i As Long
+' ARGUMENT VALIDATION
+ N = max_Long(1, N)
+' VARIABLE INSTANTIATION
+ ReDim Outs(N)
+' METHODS
+ For i = 1 To N
+ Outs(i) = value
+ Next
+' RETURNS
+ create_1D_mat_String = Outs
+End Function
+
+
+Sub copy_N_mat_String(ByRef data_in() As String, ByRef data_out() As String, ByVal N_in As Long, ByVal N_out As Long)
+' FUNCTION
+ ' Copy from one N-dimensional matrix into another all overlapping elements
+' ARGUMENTS
+ ' String Matrix data_in - matrix to copy from
+ ' String Matrix data_out - matrix receiving data
+ ' Long N_in - number of dimensions in data_in
+ ' Long N_out - number of dimensions in N_out
+' VARIABLE DECLARATION
+ Dim dims_in() As Long
+ Dim dims_out() As Long
+ Dim i As Long
+ Dim dim_min As Long
+ Dim x() As Long
+ Dim N() As Long
+' ARGUMENT VALIDATION
+ If (N_in < 1 Or N_out <> N_in) Then Exit Sub
+' VARIABLE INSTANTIATION
+ dim_min = min_Long(N_in, N_out)
+ ReDim dims_in(dim_min)
+ ReDim dims_out(dim_min)
+ ReDim x(dim_min)
+ ReDim N(dim_min)
+ For i = 1 To dim_min
+ dims_in(i) = SizeArrayDim_String(data_in, i)
+ dims_out(i) = SizeArrayDim_String(data_out, i)
+ x(i) = 1
+ N(i) = min_Long(dims_in(i), dims_out(i))
+ Next
+' METHODS
+ Do While compare_all_iterators(x, N, dim_min)
+ set_index_N_mat_String data_out, x, dim_min, get_index_N_mat_String(data_in, x, N_out)
+ iterate_iterator x, N, dim_min
+ Loop
+End Sub
+
+
+Sub copy_N_mat_Long(ByRef data_in() As Long, ByRef data_out() As Long, ByVal N_in As Long, ByVal N_out As Long)
+' FUNCTION
+ ' Copy from one N-dimensional matrix into another all overlapping elements
+' ARGUMENTS
+ ' Long Matrix data_in - matrix to copy from
+ ' Long Matrix data_out - matrix receiving data
+ ' Long N_in - number of dimensions in data_in
+ ' Long N_out - number of dimensions in N_out
+' VARIABLE DECLARATION
+ Dim dims_in() As Long
+ Dim dims_out() As Long
+ Dim i As Long
+ Dim dim_min As Long
+ Dim x() As Long
+ Dim N() As Long
+' ARGUMENT VALIDATION
+ If (N_in < 1 Or N_out <> N_in) Then Exit Sub
+' VARIABLE INSTANTIATION
+ dim_min = min_Long(N_in, N_out)
+ ReDim dims_in(dim_min)
+ ReDim dims_out(dim_min)
+ ReDim x(dim_min)
+ ReDim N(dim_min)
+ For i = 1 To dim_min
+ dims_in(i) = SizeArrayDim_Long(data_in, i)
+ dims_out(i) = SizeArrayDim_Long(data_out, i)
+ x(i) = 1
+ N(i) = min_Long(dims_in(i), dims_out(i))
+ Next
+' METHODS
+ Do While compare_all_iterators(x, N, dim_min)
+ set_index_N_mat_Long data_out, x, dim_min, get_index_N_mat_Long(data_in, x, N_out)
+ iterate_iterator x, N, dim_min
+ Loop
+End Sub
+
+
+Sub copy_N_mat_Variant(ByRef data_in() As Variant, ByRef data_out() As Variant, ByVal N_in As Long, ByVal N_out As Long)
+' FUNCTION
+ ' Copy from one N-dimensional matrix into another all overlapping elements
+' ARGUMENTS
+ ' Variant Matrix data_in - matrix to copy from
+ ' Variant Matrix data_out - matrix receiving data
+ ' Long N_in - number of dimensions in data_in
+ ' Long N_out - number of dimensions in N_out
+' VARIABLE DECLARATION
+ Dim dims_in() As Long
+ Dim dims_out() As Long
+ Dim i As Long
+ Dim dim_min As Long
+ Dim x() As Long
+ Dim N() As Long
+' ARGUMENT VALIDATION
+ If (N_in < 1 Or N_out <> N_in) Then Exit Sub
+' VARIABLE INSTANTIATION
+ dim_min = min_Long(N_in, N_out)
+ ReDim dims_in(dim_min)
+ ReDim dims_out(dim_min)
+ ReDim x(dim_min)
+ ReDim N(dim_min)
+ For i = 1 To dim_min
+ dims_in(i) = SizeArrayDim_Variant(data_in, i)
+ dims_out(i) = SizeArrayDim_Variant(data_out, i)
+ x(i) = 1
+ N(i) = min_Long(dims_in(i), dims_out(i))
+ Next
+' METHODS
+ Do While compare_all_iterators(x, N, dim_min)
+ set_index_N_mat_Variant data_out, x, dim_min, get_index_N_mat_Variant(data_in, x, N_out)
+ iterate_iterator x, N, dim_min
+ Loop
+End Sub
+
+
+Sub iterate_iterator(ByRef x() As Long, ByRef N() As Long, ByVal NDim As Long)
+' FUNCTION
+ ' Increment iterator x under limits N
+' ARGUMENTS
+ ' Long Array x - iterator
+ ' Long Array SzDim1 - iterator limits
+ ' Long NDim
+' VARIABLE DECLARATION
+ Dim i As Long
+ Dim j As Long
+' METHODS
+ For i = NDim To 1 Step -1
+ If (x(i) < N(i)) Then
+ x(i) = x(i) + 1
+ If (i < NDim) Then
+ For j = i + 1 To NDim
+ x(j) = 1
+ Next
+ End If
+ Exit Sub
+ End If
+ Next
+' RETURNS
+ x(1) = x(1) + 1 ' what is this
+End Sub
+
+
+Function compare_all_iterators(ByRef x() As Long, ByRef N() As Long, ByVal NDim As Long) As Boolean
+' FUNCTION
+ ' Are all x(i) <= N(i)
+' ARGUMENTS
+ ' Long Array x
+ ' Long Array N
+ ' Long ndim
+' VARIABLE DECLARATION
+ Dim i As Long
+' ARGUMENT VALIDATION
+ compare_all_iterators = False
+ If (NDim < 1) Then Exit Function
+' VARIABLE INSTANTIATION
+ compare_all_iterators = True
+' METHODS
+ For i = 1 To NDim
+ If Not (x(i) <= N(i)) Then
+ compare_all_iterators = False
+ Exit Function
+ End If
+ Next
+End Function
+
+
+Function create_N_mat_String(ByVal N As Long, ByRef dims() As Long) As String()
+' FUNCTION
+ ' Create N-dimensional String-type matrix
+' ARGUMENTS
+ ' Long N - number of dimensions
+ ' Long Array dims - size of each dimension
+' ARGUMENT VALIDATION
+ If Not N <= SizeArrayDim_Long(dims) Then Exit Function
+' VARIABLE INSTANTIATION
+ Select Case N
+ Case 1
+ ReDim create_N_mat_String(max_Long(1, dims(1)))
+ Case 2
+ ReDim create_N_mat_String(max_Long(1, dims(1)), max_Long(1, dims(2)))
+ Case 3
+ ReDim create_N_mat_String(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)))
+ Case 4
+ ReDim create_N_mat_String(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)), max_Long(1, dims(4)))
+ Case 5
+ ReDim create_N_mat_String(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)), max_Long(1, dims(4)), max_Long(1, dims(5)))
+ Case Else:
+ Exit Function
+ End Select
+End Function
+
+
+Function create_N_mat_Long(ByVal N As Long, ByRef dims() As Long) As Long()
+' FUNCTION
+ ' Create N-dimensional Long-type matrix
+' ARGUMENTS
+ ' Long N - number of dimensions
+ ' Long Array dims - size of each dimension
+' ARGUMENT VALIDATION
+ If Not N <= SizeArrayDim_Long(dims) Then Exit Function
+' VARIABLE INSTANTIATION
+ Select Case N
+ Case 1
+ ReDim create_N_mat_Long(max_Long(1, dims(1)))
+ Case 2
+ ReDim create_N_mat_Long(max_Long(1, dims(1)), max_Long(1, dims(2)))
+ Case 3
+ ReDim create_N_mat_Long(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)))
+ Case 4
+ ReDim create_N_mat_Long(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)), max_Long(1, dims(4)))
+ Case 5
+ ReDim create_N_mat_Long(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)), max_Long(1, dims(4)), max_Long(1, dims(5)))
+ Case Else:
+ Exit Function
+ End Select
+End Function
+
+
+Function create_N_mat_Variant(ByVal N As Long, ByRef dims() As Long) As Variant()
+' FUNCTION
+ ' Create N-dimensional Variant-type matrix
+' ARGUMENTS
+ ' Long N - number of dimensions
+ ' Long Array dims - size of each dimension
+' ARGUMENT VALIDATION
+ If Not N <= SizeArrayDim_Long(dims) Then Exit Function
+' VARIABLE INSTANTIATION
+ Select Case N
+ Case 1
+ ReDim create_N_mat_Variant(max_Long(1, dims(1)))
+ Case 2
+ ReDim create_N_mat_Variant(max_Long(1, dims(1)), max_Long(1, dims(2)))
+ Case 3
+ ReDim create_N_mat_Variant(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)))
+ Case 4
+ ReDim create_N_mat_Variant(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)), max_Long(1, dims(4)))
+ Case 5
+ ReDim create_N_mat_Variant(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)), max_Long(1, dims(4)), max_Long(1, dims(5)))
+ Case Else:
+ Exit Function
+ End Select
+End Function
+
+
+Function get_index_N_mat_String(ByRef nd_matrix() As String, ByRef position() As Long, ByVal NDim As Long) As String
+' FUNCTION
+ ' Get value from indexed cell of N-dimensional String-type matrix
+' ARGUMENTS
+ ' String Matrix nd_matrix
+ ' Long Array position
+ ' Long ndim - number of dimensions in matrix
+' VARIABLE DECLARATION
+ Dim x As Long
+' ARGUMENT VALIDATION
+ get_index_N_mat_String = "Error"
+ If NDim < 1 Then Exit Function
+ If Not SizeArrayDim_Long(position) = NDim Then Exit Function
+ If Not SizeArrayDim_String(nd_matrix, NDim) >= 1 Then Exit Function
+ For x = 1 To NDim
+ If Not SizeArrayDim_String(nd_matrix, x) >= position(x) Then Exit Function
+ If Not position(x) >= 1 Then Exit Function
+ Next
+' METHODS
+ Select Case NDim
+ Case 1:
+ get_index_N_mat_String = nd_matrix(position(1))
+ Case 2:
+ get_index_N_mat_String = nd_matrix(position(1), position(2))
+ Case 3:
+ get_index_N_mat_String = nd_matrix(position(1), position(2), position(3))
+ Case 4:
+ get_index_N_mat_String = nd_matrix(position(1), position(2), position(3), position(4))
+ Case 5:
+ get_index_N_mat_String = nd_matrix(position(1), position(2), position(3), position(4), position(5))
+ Case Else:
+ Exit Function
+ End Select
+End Function
+
+
+Function get_index_N_mat_Long(ByRef nd_matrix() As Long, ByRef position() As Long, ByVal NDim As Long) As Long
+' FUNCTION
+ ' Get value from indexed cell of N-dimensional Long-type matrix
+' ARGUMENTS
+ ' Long Matrix nd_matrix
+ ' Long Array position
+ ' Long ndim - number of dimensions in matrix
+' VARIABLE DECLARATION
+ Dim x As Long
+' ARGUMENT VALIDATION
+ get_index_N_mat_Long = "Error"
+ If NDim < 1 Then Exit Function
+ If Not SizeArrayDim_Long(position) = NDim Then Exit Function
+ If Not SizeArrayDim_Long(nd_matrix, NDim) >= 1 Then Exit Function
+ For x = 1 To NDim
+ If Not SizeArrayDim_Long(nd_matrix, x) >= position(x) Then Exit Function
+ If Not position(x) >= 1 Then Exit Function
+ Next
+' METHODS
+ Select Case NDim
+ Case 1:
+ get_index_N_mat_Long = nd_matrix(position(1))
+ Case 2:
+ get_index_N_mat_Long = nd_matrix(position(1), position(2))
+ Case 3:
+ get_index_N_mat_Long = nd_matrix(position(1), position(2), position(3))
+ Case 4:
+ get_index_N_mat_Long = nd_matrix(position(1), position(2), position(3), position(4))
+ Case 5:
+ get_index_N_mat_Long = nd_matrix(position(1), position(2), position(3), position(4), position(5))
+ Case Else:
+ Exit Function
+ End Select
+End Function
+
+
+Function get_index_N_mat_Variant(ByRef nd_matrix() As Variant, ByRef position() As Long, ByVal NDim As Long) As Variant
+' FUNCTION
+ ' Get value from indexed cell of N-dimensional Variant-type matrix
+' ARGUMENTS
+ ' Variant Matrix nd_matrix
+ ' Long Array position
+ ' Long ndim - number of dimensions in matrix
+' VARIABLE DECLARATION
+ Dim x As Long
+' ARGUMENT VALIDATION
+ get_index_N_mat_Variant = "Error"
+ If NDim < 1 Then Exit Function
+ If Not SizeArrayDim_Long(position) = NDim Then Exit Function
+ If Not SizeArrayDim_Variant(nd_matrix, NDim) >= 1 Then Exit Function
+ For x = 1 To NDim
+ If Not SizeArrayDim_Variant(nd_matrix, x) >= position(x) Then Exit Function
+ If Not position(x) >= 1 Then Exit Function
+ Next
+' METHODS
+ Select Case NDim
+ Case 1:
+ get_index_N_mat_Variant = nd_matrix(position(1))
+ Case 2:
+ get_index_N_mat_Variant = nd_matrix(position(1), position(2))
+ Case 3:
+ get_index_N_mat_Variant = nd_matrix(position(1), position(2), position(3))
+ Case 4:
+ get_index_N_mat_Variant = nd_matrix(position(1), position(2), position(3), position(4))
+ Case 5:
+ get_index_N_mat_Variant = nd_matrix(position(1), position(2), position(3), position(4), position(5))
+ Case Else:
+ Exit Function
+ End Select
+End Function
+
+
+Sub set_index_N_mat_String(ByRef nd_matrix() As String, ByRef position() As Long, ByVal NDim As Long, ByVal vNew As String)
+' FUNCTION
+ ' Get value from indexed cell of N-dimensional String-type matrix
+' ARGUMENTS
+ ' String Matrix nd_matrix
+ ' Long Array position
+ ' Long ndim - number of dimensions in matrix
+' VARIABLE DECLARATION
+ Dim x As Long
+' ARGUMENT VALIDATION
+ ' get_index_N_mat_String = "Error"
+ If NDim < 1 Then Exit Sub
+ If Not SizeArrayDim_Long(position) = NDim Then GoTo exitsub
+ If Not SizeArrayDim_String(nd_matrix, NDim) >= 1 Then GoTo exitsub
+ For x = 1 To NDim
+ If Not SizeArrayDim_String(nd_matrix, x) >= position(x) Then GoTo exitsub
+ If Not position(x) >= 1 Then GoTo exitsub
+ Next
+' METHODS
+ Select Case NDim
+ Case 1:
+ nd_matrix(position(1)) = vNew
+ Case 2:
+ nd_matrix(position(1), position(2)) = vNew
+ Case 3:
+ nd_matrix(position(1), position(2), position(3)) = vNew
+ Case 4:
+ nd_matrix(position(1), position(2), position(3), position(4)) = vNew
+ Case 5:
+ nd_matrix(position(1), position(2), position(3), position(4), position(5)) = vNew
+ Case Else:
+ Exit Sub
+ End Select
+ Exit Sub
+exitsub:
+ MsgBox "Error"
+End Sub
+
+
+Sub set_index_N_mat_Long(ByRef nd_matrix() As Long, ByRef position() As Long, ByVal NDim As Long, ByVal vNew As Long)
+' FUNCTION
+ ' Get value from indexed cell of N-dimensional String-type matrix
+' ARGUMENTS
+ ' Long Matrix nd_matrix
+ ' Long Array position
+ ' Long ndim - number of dimensions in matrix
+' VARIABLE DECLARATION
+ Dim x As Long
+' ARGUMENT VALIDATION
+ ' get_index_N_mat_String = "Error"
+ If NDim < 1 Then Exit Sub
+ If Not SizeArrayDim_Long(position) = NDim Then GoTo exitsub
+ If Not SizeArrayDim_Long(nd_matrix, NDim) >= 1 Then GoTo exitsub
+ For x = 1 To NDim
+ If Not SizeArrayDim_Long(nd_matrix, x) >= position(x) Then GoTo exitsub
+ If Not position(x) >= 1 Then GoTo exitsub
+ Next
+' METHODS
+ Select Case NDim
+ Case 1:
+ nd_matrix(position(1)) = vNew
+ Case 2:
+ nd_matrix(position(1), position(2)) = vNew
+ Case 3:
+ nd_matrix(position(1), position(2), position(3)) = vNew
+ Case 4:
+ nd_matrix(position(1), position(2), position(3), position(4)) = vNew
+ Case 5:
+ nd_matrix(position(1), position(2), position(3), position(4), position(5)) = vNew
+ Case Else:
+ Exit Sub
+ End Select
+ Exit Sub
+exitsub:
+ MsgBox "Error"
+End Sub
+
+
+Sub set_index_N_mat_Variant(ByRef nd_matrix() As Variant, ByRef position() As Long, ByVal NDim As Long, ByVal vNew As Variant)
+' FUNCTION
+ ' Get value from indexed cell of N-dimensional String-type matrix
+' ARGUMENTS
+ ' Variant Matrix nd_matrix
+ ' Long Array position
+ ' Long ndim - number of dimensions in matrix
+' VARIABLE DECLARATION
+ Dim x As Long
+' ARGUMENT VALIDATION
+ ' get_index_N_mat_String = "Error"
+ If NDim < 1 Then GoTo exitsub
+ If Not SizeArrayDim_Long(position) = NDim Then GoTo exitsub
+ If Not SizeArrayDim_Variant(nd_matrix, NDim) >= 1 Then GoTo exitsub
+ For x = 1 To NDim
+ If Not SizeArrayDim_Variant(nd_matrix, x) >= position(x) Then GoTo exitsub
+ If Not position(x) >= 1 Then GoTo exitsub
+ Next
+' METHODS
+ Select Case NDim
+ Case 1:
+ nd_matrix(position(1)) = vNew
+ Case 2:
+ nd_matrix(position(1), position(2)) = vNew
+ Case 3:
+ nd_matrix(position(1), position(2), position(3)) = vNew
+ Case 4:
+ nd_matrix(position(1), position(2), position(3), position(4)) = vNew
+ Case 5:
+ nd_matrix(position(1), position(2), position(3), position(4), position(5)) = vNew
+ Case Else:
+ Exit Sub
+ End Select
+ Exit Sub
+exitsub:
+ MsgBox "Error"
+End Sub
+
+
+Sub convert_1D_Variant_2_String(ByRef input_array() As Variant, ByRef return_array() As String)
+' FUNCTION
+ ' Convert 1D Variant array to 1D String array
+' ARGUMENTS
+ ' Variant Array input_array
+ ' String Array return_array
+' VARIABLE DECLARATION
+ Dim N As Long
+ Dim i As Long
+' ARGUMENT VALIDATION
+ If ((Not input_array) = -1) Then
+ ReDim return_array(1)
+ return_array(1) = "Error"
+ Exit Sub
+ End If
+' VARIABLE INSTANTIATION
+ N = SizeArrayDim_Variant(input_array)
+ ReDim return_array(N)
+' METHODS
+ For i = 1 To N
+ return_array(i) = CStr(input_array(i))
+ Next
+End Sub
+
+
+Sub convert_1D_Variant_2_Long(ByRef input_array() As Variant, ByRef return_array() As Long)
+' FUNCTION
+ ' Convert 1D Variant array to 1D Long array
+' ARGUMENTS
+ ' Variant Array input_array
+ ' Long Array return_array
+' VARIABLE DECLARATION
+ Dim N As Long
+ Dim i As Long
+' ARGUMENT VALIDATION
+ If ((Not input_array) = -1) Then
+ ReDim return_array(1)
+ return_array(1) = "Error"
+ Exit Sub
+ End If
+' VARIABLE INSTANTIATION
+ N = SizeArrayDim_Variant(input_array)
+ ReDim return_array(N)
+' METHODS
+ For i = 1 To N
+ return_array(i) = CStr(input_array(i))
+ Next
+End Sub
+
+
+Sub convert_2D_Variant_2_String(ByRef input_array() As Variant, ByRef return_array() As String)
+' FUNCTION
+ ' Convert 2D matrix from Variant to String
+' ARGUMENTS
+ ' Variant Array input_array
+ ' String Array return_array
+' VARIABLE DECLARATION
+ Dim N(2) As Long
+ Dim i As Long
+ Dim j As Long
+' ARGUMENT VALIDATION
+ If ((Not input_array) = -1) Then
+ ReDim return_array(1)
+ return_array(1) = "Error"
+ Exit Sub
+ End If
+' VARIABLE INSTANTIATION
+ ' ReDim N(2)
+ N(1) = SizeArrayDim_Variant(input_array, 1)
+ N(2) = SizeArrayDim_Variant(input_array, 2)
+ ReDim return_array(N(1), N(2))
+' METHODS
+ For i = 1 To N(1)
+ For j = 1 To N(2)
+ return_array(i, j) = CStr(input_array(i, j))
+ Next
+ Next
+End Sub
+
+
+Sub convert_2D_Variant_2_Long(ByRef input_array() As Variant, ByRef return_array() As Long)
+' FUNCTION
+ ' Convert 2D matrix from Variant to Long
+' ARGUMENTS
+ ' Variant Array input_array
+ ' Long Array return_array
+' VARIABLE DECLARATION
+ Dim N() As Long
+ Dim i As Long
+ Dim j As Long
+' ARGUMENT VALIDATION
+ If ((Not input_array) = -1) Then
+ ReDim return_array(1)
+ return_array(1) = "Error"
+ Exit Sub
+ End If
+' VARIABLE INSTANTIATION
+ ReDim N(2)
+ N(1) = SizeArrayDim_Variant(input_array, 1)
+ N(2) = SizeArrayDim_Variant(input_array, 2)
+ ReDim return_array(N(1), N(2))
+' METHODS
+ For i = 1 To N(1)
+ For j = 1 To N(2)
+ return_array(i, j) = CLng(input_array(i, j))
+ Next
+ Next
+End Sub
+
+
+Function last_filled_cell(ByVal array1D As Variant, Optional start As Long = 1, Optional max_i As Long = -1, Optional gap_max As Long = 1, Optional dir_move As dir_traverse = dir_traverse.FORWARDS) As Long
+' FUNCTION
+ ' Find last populated cell in 1D array from start to max_i with maximum number of consecutive empty cells gap_max
+' ARGUMENTS
+ ' Variant Array array1D
+ ' Long start
+ ' Long max_i
+ ' Long gap_max
+ ' dir_traverse dir_move
+' VARIABLE DECLARATION
+ Dim found_last As Boolean
+ Dim temp As Variant
+ Dim gap_count As Long
+ Dim i As Long
+' ARGUMENT VALIDATION
+ If max_i < 1 Then
+ max_i = SizeArrayDim_Variant_0(array1D)
+ End If
+ If (start < 0 Or start > max_i) Then Exit Function
+' VARIABLE INSTANTIATION
+ If dir_move = FORWARDS Then
+ i = start - 1
+ Else
+ i = max_i
+ max_i = start
+ start = i
+ i = max_i + 1
+ End If
+' METHODS
+ Do While Not found_last
+ i = i + 1
+ If i = max_i Then
+ found_last = True
+ ElseIf IsEmpty(array1D(i)) Or array1D(i) = "" Then
+ gap_count = gap_count + 1
+ Else
+ gap_count = 0
+ End If
+ If gap_count > gap_max Then
+ found_last = True
+ End If
+ Loop
+' RETURNS
+ last_filled_cell = i - gap_count
+End Function
+
+
+Function max_n_Long(ByRef array1D() As Long, Optional N As Long = 0, Optional start As Long = 1, Optional dir_move As dir_traverse = dir_traverse.FORWARDS) As Long
+' FUNCTION
+ ' Maximum Long value in array1D from start up to start + N - 1
+' ARGUMENTS
+ ' Long Array array1D
+ ' Long N - number of elements to check
+ ' Long start - first element to check
+' VARIABLE DECLARATION
+ Dim i As Long
+ Dim max_i As Long
+ Dim grand_max As Long
+' ARGUMENT VALIDATION
+ start = max_Long(1, start)
+ max_i = SizeArrayDim_Long(array1D)
+ If N > 0 Then
+ If start + N - 1 > max_i Then
+ MsgBox "Invalid search indices for array of size " & CStr(max_i)
+ End If
+ End If
+' METHODS
+ If dir_move = FORWARDS Then
+ For i = start To max_i
+ grand_max = max_Long(grand_max, array1D(i))
+ Next
+ Else
+ For i = start To 1 Step -1
+ grand_max = max_Long(grand_max, array1D(i))
+ Next
+ End If
+' RETURNS
+ max_n_Long = grand_max
+End Function
+
+
+Function min_n_Long(ByRef array1D() As Long, Optional N As Long = 0, Optional start As Long = 1, Optional dir_move As dir_traverse = dir_traverse.FORWARDS) As Long
+' FUNCTION
+ ' Minimum Long value in array1D from start up to start + N - 1
+' ARGUMENTS
+ ' Long Array array1D
+ ' Long N - number of elements to check
+ ' Long start - first element to check
+' VARIABLE DECLARATION
+ Dim i As Long
+ Dim max_i As Long
+ Dim grand_min As Long
+' ARGUMENT VALIDATION
+ start = max_Long(1, start)
+ max_i = SizeArrayDim_Long(array1D)
+ If N > 0 Then
+ If start + N - 1 > max_i Then
+ MsgBox "Invalid search indices for array of size " & CStr(max_i)
+ End If
+ End If
+' METHODS
+ If dir_move = FORWARDS Then
+ For i = start To max_i
+ grand_min = min_Long(grand_min, array1D(i))
+ Next
+ Else
+ For i = start To 1 Step -1
+ grand_min = min_Long(grand_min, array1D(i))
+ Next
+ End If
+' RETURNS
+ min_n_Long = grand_min
+End Function
+
+
+Function match_Long(ByVal key As Long, ByRef array1D() As Long, Optional start As Long = 1, Optional max_i As Long = 0, Optional dir_move As dir_traverse = dir_traverse.FORWARDS) As Long
+' FUNCTION
+ ' Find first or last instance of key in array1D
+' ARGUMENTS
+ ' Long key
+ ' Long Array array1D
+ ' Long start
+ ' Long max_i
+ ' dir_traverse dir_move
+' VARIABLE DECLARATION
+ Dim i As Long
+' ARGUMENT VALIDATION
+ If max_i < 1 Then
+ max_i = SizeArrayDim_Long(array1D)
+ End If
+ If (start < 0 Or start > max_i) Then Exit Function
+' METHODS
+ If dir_move = FORWARDS Then
+ For i = start To max_i
+ If array1D(i) = key Then
+ match_Long = i
+ Exit Function
+ End If
+ Next
+ Else
+ For i = start To 1 Step -1
+ If array1D(i) = key Then
+ match_Long = i
+ Exit Function
+ End If
+ Next
+ End If
+End Function
+
+
+Function match_String(ByVal key As String, ByRef array1D() As String, Optional start As Long = 1, Optional max_i As Long = 0, Optional dir_move As dir_traverse = dir_traverse.FORWARDS) As Long
+' FUNCTION
+ ' Find first or last instance of key in array1D
+' ARGUMENTS
+ ' String key
+ ' String Array array1D
+ ' Long start
+ ' Long max_i
+ ' dir_traverse dir_move
+' VARIABLE DECLARATION
+ Dim i As Long
+' ARGUMENT VALIDATION
+ If max_i < 1 Then
+ max_i = SizeArrayDim_String(array1D)
+ End If
+ If (start < 0 Or start > max_i) Then Exit Function
+' METHODS
+ If dir_move = FORWARDS Then
+ For i = start To max_i
+ If array1D(i) = key Then
+ match_String = i
+ Exit Function
+ End If
+ Next
+ Else
+ For i = start To 1 Step -1
+ If array1D(i) = key Then
+ match_String = i
+ Exit Function
+ End If
+ Next
+ End If
+End Function
+
+
+Function match_Variant(ByVal key As Variant, ByRef array1D() As Variant, Optional start As Long = 1, Optional max_i As Long = 0, Optional dir_move As dir_traverse = dir_traverse.FORWARDS) As Long
+' FUNCTION
+ ' Find first or last instance of key in array1D
+' ARGUMENTS
+ ' Variant key
+ ' Variant Array array1D
+ ' Long start
+ ' Long max_i
+ ' dir_traverse dir_move
+' VARIABLE DECLARATION
+ Dim i As Long
+' ARGUMENT VALIDATION
+ If max_i < 1 Then
+ max_i = SizeArrayDim_Variant(array1D, 2)
+ End If
+ If (start < 0 Or start > max_i) Then Exit Function
+' METHODS
+ If dir_move = FORWARDS Then
+ For i = start To max_i
+ If array1D(i) = key Then
+ match_Variant = i
+ Exit Function
+ End If
+ Next
+ Else
+ For i = start To 1 Step -1
+ If array1D(i) = key Then
+ match_Variant = i
+ Exit Function
+ End If
+ Next
+ End If
+End Function
+
+
+Function change_array_base_String(ByRef array1D() As String, Optional base_new As Long = 1) As String()
+' FUNCTION
+ ' Change base of array1D to new_base, if necessary
+' ARGUMENTS
+ ' String Array array1D
+ ' Long base_new
+' VARIABLE DECLARATION
+ Dim base_old As Long
+ Dim i As Long
+ Dim N As Long
+ Dim array_out() As String
+' ARGUMENT VALIDATION
+ N = SizeArrayDim_String(array1D)
+ If N < 1 Then Exit Function
+' VARIABLE INSTANTIATION
+ base_old = LBound(array1D)
+ ReDim array_out(N)
+' METHODS
+ If base_old = base_new Then
+ change_array_base_String = array1D
+ Exit Function
+ End If
+ For i = 1 To N
+ array_out(base_new + i - 1) = array1D(base_old + i - 1)
+ Next
+' RETURNS
+ change_array_base_String = array_out
+End Function
+
+
+Function get_1D_strip_N_mat_String(ByRef N_mat() As String, ByVal dimension As Long, ByRef position() As Long) As String()
+' FUNCTION
+ ' Get 1D array of String-type N-dimensional matrix with all but one dimension fixed
+' ARGUMENTS
+ ' String Array N_mat
+ ' Long dimension - dimension of N-mat to vary
+ ' Long Array position - fixed coordinates
+' VARIABLE DECLARATION
+ Dim Outs() As String
+ Dim x() As Long
+ Dim i As Long
+ Dim N As Long
+ Dim x_max As Long
+ Dim p_max As Long
+' ARGUMENT VALIDATION
+ If dimension < 1 Then
+ MsgBox "Error: Dimension out of range."
+ Exit Function
+ End If
+ p_max = SizeArrayDim_Long(position)
+ If p_max = 0 Then
+ MsgBox "Error: Position is nothing."
+ Exit Function
+ End If
+ If (p_max < dimension - 1) Then
+ MsgBox "Error: Insufficient quantity of dimensions in position for dimension " & CStr(dimension) & "."
+ Exit Function
+ End If
+ x_max = SizeArrayDim_String(N_mat, N)
+ If x_max = 0 Then
+ MsgBox "Error: N-dimensional Matrix of insufficient quantity of dimensions."
+ Exit Function
+ End If
+ x_max = SizeArrayDim_String(N_mat, N + 1)
+ If x_max > 0 Then
+ MsgBox "Error: N-dimensional Matrix of too many dimensions."
+ Exit Function
+ End If
+' VARIABLE INSTANTIATION
+ x_max = SizeArrayDim_String(N_mat, dimension)
+ ReDim Outs(x_max)
+ ReDim x(N)
+ For i = 1 To p_max
+ x(i) = position(i)
+ Next
+' METHODS
+ For i = 1 To x_max
+ x(dimension) = i
+ Outs(i) = get_index_N_mat_String(N_mat, x, N)
+ Next
+' RETURNS
+ get_1D_strip_N_mat_String = Outs
+End Function
+
+
+Function get_1D_strip_N_mat_Long(ByRef N_mat() As Long, ByVal dimension As Long, ByRef position() As Long) As Long()
+' FUNCTION
+ ' Get 1D array of Long-type N-dimensional matrix with all but one dimension fixed
+' ARGUMENTS
+ ' String Array N_mat
+ ' Long dimension - dimension of N-mat to vary
+ ' Long Array position - fixed coordinates
+' VARIABLE DECLARATION
+ Dim Outs() As Long
+ Dim x() As Long
+ Dim i As Long
+ Dim N As Long
+ Dim x_max As Long
+ Dim p_max As Long
+' ARGUMENT VALIDATION
+ If dimension < 1 Then
+ MsgBox "Error: Dimension out of range."
+ Exit Function
+ End If
+ p_max = SizeArrayDim_Long(position)
+ If p_max = 0 Then
+ MsgBox "Error: Position is nothing."
+ Exit Function
+ End If
+ If (p_max < dimension - 1) Then
+ MsgBox "Error: Insufficient quantity of dimensions in position for dimension " & CStr(dimension) & "."
+ Exit Function
+ End If
+ N = max_Long(dimension, p_max)
+ x_max = SizeArrayDim_Long(N_mat, N)
+ If x_max = 0 Then
+ MsgBox "Error: N-dimensional Matrix of insufficient quantity of dimensions."
+ Exit Function
+ End If
+ x_max = SizeArrayDim_Long(N_mat, N + 1)
+ If x_max > 0 Then
+ MsgBox "Error: N-dimensional Matrix of too many dimensions."
+ Exit Function
+ End If
+' VARIABLE INSTANTIATION
+ x_max = SizeArrayDim_Long(N_mat, dimension)
+ ReDim Outs(x_max)
+ ReDim x(N)
+ For i = 1 To p_max
+ x(i) = position(i)
+ Next
+' METHODS
+ For i = 1 To x_max
+ x(dimension) = i
+ Outs(i) = get_index_N_mat_Long(N_mat, x, N)
+ Next
+' RETURNS
+ get_1D_strip_N_mat_Long = Outs
+End Function
+
+
+Function get_1D_strip_N_mat_Variant(ByRef N_mat() As Variant, ByVal dimension As Long, ByRef position() As Long) As Variant()
+' FUNCTION
+ ' Get 1D array of Variant-type N-dimensional matrix with all but one dimension fixed
+' ARGUMENTS
+ ' String Array N_mat
+ ' Long dimension - dimension of N-mat to vary
+ ' Long Array position - fixed coordinates
+' VARIABLE DECLARATION
+ Dim Outs() As Variant
+ Dim x() As Long
+ Dim i As Long
+ Dim N As Long
+ Dim x_max As Long
+ Dim p_max As Long
+' ARGUMENT VALIDATION
+ If dimension < 1 Then
+ MsgBox "Error: Dimension out of range."
+ Exit Function
+ End If
+ p_max = SizeArrayDim_Long(position)
+ If p_max = 0 Then
+ MsgBox "Error: Position is nothing."
+ Exit Function
+ End If
+ If (p_max < dimension - 1) Then
+ MsgBox "Error: Insufficient quantity of dimensions in position for dimension " & CStr(dimension) & "."
+ Exit Function
+ End If
+ x_max = SizeArrayDim_Variant(N_mat, N)
+ If x_max = 0 Then
+ MsgBox "Error: N-dimensional Matrix of insufficient quantity of dimensions."
+ Exit Function
+ End If
+ x_max = SizeArrayDim_Variant(N_mat, N + 1)
+ If x_max > 0 Then
+ MsgBox "Error: N-dimensional Matrix of too many dimensions."
+ Exit Function
+ End If
+' VARIABLE INSTANTIATION
+ x_max = SizeArrayDim_Variant(N_mat, dimension)
+ ReDim Outs(x_max)
+ ReDim x(N)
+ For i = 1 To p_max
+ x(i) = position(i)
+ Next
+' METHODS
+ For i = 1 To x_max
+ x(dimension) = i
+ Outs(i) = get_index_N_mat_Variant(N_mat, x, N)
+ Next
+' RETURNS
+ get_1D_strip_N_mat_Variant = Outs
+End Function
+
+
+Function Mod_Double(ByVal numerator As Double, ByVal denominator As Double) As Double
+' FUNCTION
+ ' Modulo method for doubles
+' ARGUMENTS
+ ' Double numerator
+ ' Double denominator
+' METHODS
+ Do While numerator > denominator
+ numerator = numerator - denominator
+ Loop
+ Do While numerator < 0
+ numerator = numerator + denominator
+ Loop
+' RETURNS
+ Mod_Double = numerator
+End Function
+
+
+Function Div_Double(ByVal numerator As Double, ByVal denominator As Double) As Long
+' FUNCTION
+ ' Modular division method for doubles
+' ARGUMENTS
+ ' Double numerator
+ ' Double denominator
+' VARIABLE DECLARATION
+ Dim count As Long
+' VARIABLE DECLARATION
+ count = 0
+' METHODS
+ Do While numerator > denominator
+ count = count + 1
+ numerator = numerator - denominator
+ Loop
+ Do While numerator < 0
+ count = count - 1
+ numerator = numerator + denominator
+ Loop
+' RETURNS
+ Div_Double = count
+End Function
+
diff --git a/src/Range_Strings.bas b/src/Range_Strings.bas
new file mode 100644
index 0000000..7e8c2e4
--- /dev/null
+++ b/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
diff --git a/src/String_Operations.bas b/src/String_Operations.bas
new file mode 100644
index 0000000..68e38fc
--- /dev/null
+++ b/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
diff --git a/src/Validation_Comparison.bas b/src/Validation_Comparison.bas
new file mode 100644
index 0000000..fcf0f0a
--- /dev/null
+++ b/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
diff --git a/src/WS_Access.cls b/src/WS_Access.cls
new file mode 100644
index 0000000..26d8867
--- /dev/null
+++ b/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
diff --git a/src/WS_Relation.cls b/src/WS_Relation.cls
new file mode 100644
index 0000000..60e346e
--- /dev/null
+++ b/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
+