' Copyright 2005-2007 Ondrej Kalny, ok AT bridgeart DOT net
' http://www.bridgeart.net
'
'
' This code was originally written by Ondrej Kalny.
' You are free to distribute it, modify it, or use it
' in any application, provided the copyright notice is
' left unchanged and "revisions history" is updated to
' reflect all modifications.
'
' Ondrej Kalny



' -----------------------------------------------------------------------------------
' Generic Database Spreadsheet - Data Transfer Functions
' -----------------------------------------------------------------------------------



' REVISIONS HISTORY:
'-------------------------
' 8/23/2005: written by ok
'
'----------------------------------------------------------------------------------------------------
' 9/2/2005 [ver 0.1]: user can control, as a part of the field key, whether to save formula or value;
'                     first subfield has designation 0
'
'                     EXAMPLE:
'                     key x01v23x123v has the following meaning
'                           | ||  ||
'                           | ||  |+13v ... save VALUE to subfield 13
'                           | ||  |
'                           | ||  +12 ... save FORMULA to subfield 12
'                           | ||
'                           | |+3 ... save FORMULA to subfield 3
'                           | |
'                           | +2 ... save FORMULA to subfield 3
'                           |
'                           +1v ... save VALUE to subfield 3
'
'                      NOTES:
'                       1) Each subfield location consist of a 2-digit number (even 1-digit number is
'                          expressed by 2 digits, the first digit is zero in this case)
'                       2) x designates that the base changes (base is the first digit of the
'                          2-digit subfield designation
'                       3) v designates that value should be saved (formula is saved by default)
'
'                      (revised by ok)
'
'------------------------------------------------------------------------------------------------------
' 7/27/2007 [ver 0.11]: added copyright notice
'
'                       (revised by ok)



Attribute VB_Name = "s_DatabaseFunctions_0pt11"
Option Explicit


Function FindRecordStartColumn(sheetName As String, begDatabaseCell As String, recordName As String, _
    maxNumSubfields As Integer)

    Dim column As Integer 'record column

    column = 0
    Do While ((recordName <> Sheets(sheetName).Range(begDatabaseCell).Offset(-1, column).Value) _
        And (column <> -1))
        column = column + maxNumSubfields
        If (Sheets(sheetName).Range(begDatabaseCell).Offset(-1, column).Value = "") Then
            MsgBox "WARNING: Unable to find record in database in " & sheetName & " tab!"
            column = -1
        End If
    Loop
    'MsgBox column 'DEBUG
    FindRecordStartColumn = column

End Function



Sub UploadFromDatabase(ByVal sheetName As String, _
    ByVal begCalcsCell As String, ByVal begKeyCell As String, ByVal begDatabaseCell As String, _
    ByVal recordName As String, _
    ByVal maxNumRecordFields As Integer, ByVal maxNumRecordSubfields As Integer)
    
    If (recordName = "") Then Exit Sub
    
    Dim i, j, column, location, base, subfieldOffset As Integer
    Dim key As String
    
    column = FindRecordStartColumn(sheetName, begDatabaseCell, recordName, maxNumRecordSubfields)
    If (column = -1) Then
        Exit Sub
    End If
    
    For i = 0 To maxNumRecordFields
        key = Sheets(sheetName).Range(begKeyCell).Offset(i, 0).Value
        location = 1
        Do While (location <= Len(key))
            If Mid(key, location, 1) = "x" Then
                base = 10 * Mid(key, location + 1, 1)
                subfieldOffset = base + Mid(key, location + 2, 1)
                location = location + 3
            Else
                subfieldOffset = base + Mid(key, location, 1)
                location = location + 1
            End If
            
            If Mid(key, location, 1) <> "v" Then
                Sheets(sheetName).Range(begCalcsCell).Offset(i, subfieldOffset).Formula = _
                    Sheets(sheetName).Range(begDatabaseCell).Offset(i, column + subfieldOffset).Formula
            Else
                Sheets(sheetName).Range(begCalcsCell).Offset(i, subfieldOffset).Value = _
                    Sheets(sheetName).Range(begDatabaseCell).Offset(i, column + subfieldOffset).Value
                location = location = 1
            End If
                    
            'MsgBox "row offset = " & i & "   subfieldoffset = " & subfieldOffset 'DEBUG
        Loop
    Next i
    
End Sub



Sub SaveToDatabase(ByVal sheetName As String, _
    ByVal begCalcsCell As String, ByVal begKeyCell As String, ByVal begDatabaseCell As String, _
    ByVal recordName As String, _
    ByVal maxNumRecordFields As Integer, ByVal maxNumRecordSubfields As Integer)
    
    If (recordName = "") Then Exit Sub
    
    Dim i, j, column, location, base, subfieldOffset As Integer
    Dim key As String
    
    column = FindRecordStartColumn(sheetName, begDatabaseCell, recordName, maxNumRecordSubfields)
    If (column = -1) Then
        Exit Sub
    End If
    
    For i = 0 To maxNumRecordFields
        
        'clear all old records first (slows down the spreadsheet significantly
        'For j = 0 To maxNumRecordSubfields
        '    Sheets(sheetName).Range(begDatabaseCell).Offset(i, column + j).Value = ""
        'Next j
    
        key = Sheets(sheetName).Range(begKeyCell).Offset(i, 0).Value
        location = 1
        
        Do While (location <= Len(key))
            
            If Mid(key, location, 1) = "x" Then
                base = 10 * Mid(key, location + 1, 1)
                subfieldOffset = base + Mid(key, location + 2, 1)
                location = location + 3
            Else
                subfieldOffset = base + Mid(key, location, 1)
                location = location + 1
            End If
            
            If Mid(key, location, 1) <> "v" Then
                Sheets(sheetName).Range(begDatabaseCell).Offset(i, column + subfieldOffset).Formula = _
                    Sheets(sheetName).Range(begCalcsCell).Offset(i, subfieldOffset).Formula
            Else
                Sheets(sheetName).Range(begDatabaseCell).Offset(i, column + subfieldOffset).Value = _
                    Sheets(sheetName).Range(begCalcsCell).Offset(i, subfieldOffset).Value
                location = location + 1
            End If
                    
            'MsgBox "row offset = " & i & "   subfieldoffset = " & subfieldOffset 'DEBUG
        Loop
        
    Next i

End Sub