Learn Microsoft Access Advanced Programming Techniques, Tips and Tricks.

Indexing and Sorting with VBA

A Table is normally created with a Primary Key or Index to arrange the records into certain order to view or process. Primary Key or Index can have one or more fields, in order to make the Key Values Unique, if this is not possible with a single field.

If you open the Employees Table from C:\Program Files\Microsoft Office\Office11\Samples\Northwind.mdb sample Database in design view you can see that the EmployeeID Field is defined as Primary Key.

To create an Index manually and to define it as Primary Key:

  1. Open the Table in design View.
  2. Click at the left side of the Field Name to select it.
  3. Click on the Indexes Toolbar Button.
  4. You may give any suitable name in the Index Name Field replacing PrimaryKey, if you would like to do so.

If the Record Values in the selected field are not unique then you can select more data fields (up to a maximum of ten Fields) to form Unique Key for the Primary Key.

You may click and drag over the Fields to select them (if they are adjoining fields) or click on each field by holding the Ctrl Key to select fields randomly.

The above procedure is for creating a PrimaryKey Index for the Table. We can create more than one Index for a Table. But, only one Index can be active at one time.

We can activate an existing Index of a Table or create new Index through VBA and use it for data processing. We will learn here how to create a new Index with the name myIndex for a Table through VBA, activate it and use it for data processing and delete it at the end of the process.

We must validate the presence of myIndex in the Indexes collection of the Table, if found then activate it, otherwise create myIndex and activate it for data processing.

We will use Orders and Order details Table from Northwind.mdb sample database. We will organize the Order Details Table in Order Number sequence so that Order-wise Total Value of all items can be calculated and updated on the same Order record in Orders Table.

Following are the data processing steps which we follow in the VBA Routine to update the Orders Table with order-wise Total Value from Order details Table:

  1. Open Orders Table for Update Mode.
  2. Open Orders Details Table for Input.
  3. Check for the presence of myIndex in the Order Details Table, if found then activate it, otherwise create myIndex and activate it as current Index.
  4. Initialize Total to Zero.
  5. Read the first record from the Order details Table.
  6. Calculate Total Value of the item using the Expression: Quantity * ((1-Discount%)*UnitPrice).
  7. Add the Value to the Total.
  8. Read the next record and compare with the earlier Order Number, if same then repeat step-6 and 7 until the Order Number changes or no more records to process from Order Details Table.
  9. Find the record with the Order Number in Orders Table.
  10. If found then edit and updateTotal into the TotalValue Field in Orders Table.
  11. Check for End Of File (EOF) condition of Order Details Table.
  12. If False then repeat the Process from Step-4 onwards, otherwise Close files and stop Run.
  1. To try the above method Import Orders and Order Details Tables from C:\Program Files\Microsoft Office\Office11\Samples\Northwind.mdb (Access 2003) or C:\Users\User\My documents\Northwind 2007.accdb (Access 2007, if not available then you must create from Local Templates)
  2. Open Orders Table in Design View.
  3. Add a new Field with the name TotalValue with Numeric (Double) data Type in Orders Table.

    You may display the Index List of this Table to view its PrimaryKey Index on Order ID field.

  4. Save the Orders Table.
  5. Open the VBA Editing Window (Alt+F11).
  6. Create a new Standard Module from Insert Menu.
  7. Copy and Paste the following VBA Routine and save the Module.
    Public Function CreateIndex()
    Dim db As Database, fld As Field, tbldef As TableDef
    Dim idx As Index, rst As Recordset, PreviousOrderID As Long
    Dim CurrentOrderID As LongDim xQuantity As Long, xUnitPrice As Double
    Dim xDiscount As Double, Total As Double, rst2 As Recordset
    
    On Error Resume Next
    
    Set db = CurrentDb
    Set rst = db.OpenRecordset("Order Details", dbOpenTable)
    'Check for presence of myIndex, if found set as current
    rst.Index = "myIndex"
    If Err = 3800 Then
    'myIndex not found
        Err.Clear
        GoSub myNewIndex
    End If
    
    On Error GoTo CreateIndex_Err
    
    Set rst2 = db.OpenRecordset("Orders", dbOpenTable)
    rst2.Index = "PrimaryKey"
    PreviousOrderID = rst![Order ID]
    CurrentOrderID = PreviousOrderID
    Do Until rst.EOF
        Total = 0
        Do While CurrentOrderID = PreviousOrderID
            xQuantity = rst![quantity]
            xUnitPrice = rst![unit price]
            xDiscount = rst![discount]
    
            Total = Total + (xQuantity * ((1 - xDiscount) * xUnitPrice))
            rst.MoveNext
            PreviousOrderID = CurrentOrderID
            If Not rst.EOF Then
                CurrentOrderID = rst![Order ID]
            Else
                Exit Do
            End If
        Loop
        rst2.Seek "=", PreviousOrderID
        If Not rst2.NoMatch Then
            rst2.Edit
            rst2![totalvalue] = Total
            rst2.Update
        End If
        PreviousOrderID = CurrentOrderID
    Loop
    
    rst.Close
    rst2.Close
    
    'Delete temporary Index
    Set tbldef = db.TableDefs("Order details")
    tbldef.Indexes.Delete "myIndex"
    
    CreateIndex_Exit:
    Exit Function
    
    myNewIndex:
    rst.Close
    Set tbldef = db.TableDefs("Order Details")
    Set idx = tbldef.CreateIndex("myIndex")
    
    Set fld = tbldef.CreateField("Order ID", dbLong)
    idx.Fields.Append fld
    Set fld = tbldef.CreateField("Product ID", dbLong)
    idx.Fields.Append fld
    tbldef.Indexes.Append idx
    tbldef.Indexes.Refresh
    Set rst = db.OpenRecordset("Order Details", dbOpenTable)
    rst.Index = "myIndex"
    Return
    
    CreateIndex_Err:
    MsgBox Err.Description, , "CreateIndex()"
    Resume CreateIndex_Exit
    
    End Function
  8. Click somewhere in the middle of the VBA Routine and press F5 or click Run Command Button to execute the Code and update the Orders Table.

At the beginning part of the Code we are attempting to make one of the Indexes (myIndex) of Order Details Table active. Since, myIndex is not yet created on the Table this action runs into an Error condition. we are trapping this Error Code and passes control to the Sub-Routine to create myIndex and to add it to the Indexes collection. The new Index is activated in preparation for data processing.

Next steps calculate Order-wise Total Values and updates on Orders Table.

At the end of the process myIndex is deleted from the Indexes Collection of Order Details Table.

Share:

Data Upload Controls

In some Projects we have to upload data regularly from external data sources like dBase, Excel, flat files like CSV, Text and so on. The external file can remain linked to the Project and the data from them can be added into the local MS-Access Table for preparing Reports

For example, let us say we have an MS-Access Application that prepares monthly Reports on Profitability of Businesses and to do this we must upload raw data on Revenue and Expenses received every month in one of the file Formats mentioned above. If our Application is designed in a such way that when the existing linked file is replaced with new data file with the same name then the Application must be able to identify the presence of new data in the attached file and allow the User to upload the new records into the master file. But, before this action is allowed it become our responsibility as a developer to see that the data once uploaded is not allowed into the System again.

To do this we must install a procedure that will check for the presence of new data in the attached File. If found then enable a Command Button that will allow the User to click and upload the new data into the System. Otherwise keep the Command Button disabled till such time fresh data is detected in the attached file.

So, how do we detect the presence of fresh data in the attached file? Depending on the type of file we can use different approaches to determine the presence of fresh data in the attached file by checking continuity of some Control Number like Invoice Number or the Last Receipt Date, or any other set of unique values that you can depend on from the last uploaded data, and compare them with those Values of the attached file. If the compared values on both files are same then we can assume that the attached file contents are already uploaded earlier, otherwise prepare to upload fresh data. For this kind of checking we may prepare few Queries to filter the set of values from both files and read those values into a VBA routine to compare and control the flow of action.

But, I use a simple method to check the presence of new data in the attached file. Before going into that we have to consider few other issues. If the attached external file is on the local drive of each User and all of them are allowed to run the upload action then it is difficult to keep control of this action and the data can go wrong as well. If the attached file is kept on Server and only one authorized User is allowed to execute the Upload action then there can be some control over the procedure. Depending on all these considerations we have to device a method to upload the data correctly into the database.

I have several Applications that upload data from AS400, dbase, Excel and AS400 Report Spool Files too. I have tried out several methods to detect the presence of fresh information in those files using Queries with control data from tables within the Database and from linked tables. Perhaps, you may wonder what I did for AS400 Report Spool Files. This File cannot be kept attached with the database because it doesn't have the correct data table format except the Detail Lines.

I have developed programs that will read the spool file line by line and discard unwanted lines like Header, Footer, underlines, blank lines etc. and to take only data lines cut into text fields in a Table initially before converting each field values into their respective data types and write it out into a new table.

But, the question remains as how do I keep track of the presence of new Report Spool File that cannot be kept attached to the Database at all. It is a simple trick. At the end of the upload action of the current file I will make a copy of first 50 lines of the Spool File and create a second control file. Whenever the Application is open by the User a program is run to open both files and do a line by line comparison. If there is no difference in the first 50 lines of both files then the data was already uploaded into the System otherwise the System is prepared to upload fresh data from new file.

After trying several methods with different file types I thought we need a simple method that should work for all kind of files (attached to the system or not) and created one, which is presented below for your use, if needed.

We need a small table with the following Fields:

Field NameData TypeField Size
FileLengthLong Integer 
FileDateTimeDate/Time 
UserNameText25
UploadDateDate/Time 
FilePathText255

The sample table in Datasheet View:

The idea works something like this. When we upload the file contents we will save some basic information of the attached file, like File-Size in number of bytes and the last modified date and time of the file. Besides that, the name of the User (if the database is implemented with Microsoft Access Security) who is authorized to run the upload action and the date of last upload event took place.

We can read the attached File-Size in bytes with the Function: FileLen(PathName) and the File's last modified Date and Time can be obtained with the Function FileDateTime(PathName). After the upload action these values can be updated into the above table to cross-check with the values of the external file to determine the presence of new data. If needed we can set the attached file's Read-Only attribute ON with the Function SetAttr(PathName,vbReadOnly) so that the file can be protected from inadvertent changes. It can be reset to Normal with SetAttr(PathName,vbNormal).

A program must be run immediately after the Main Switchboard Form is open and cross check the File-size and the File Date/Time recorded in the table with the attached file's attributes and if found different then we can be sure that new data have arrived and enable the Command Button so that the User can click and upload new data.

But, if the User kept the Application open and replaced the attached file with new one then the Button will remain disabled because the status checking program runs only when the Main Switchboard opens. Instead of asking the user to close and open the Application again, as a standard procedure in these circumstances, we can create another Command Button with Refresh Caption so that when the User clicks on this Button we can run the above procedure and enable the Upload Button if the file attributes indicates the presence of new file.

A sample VBA Routine is given below that reads the information from the table and cross checks with the attributes of the attached file and Enable/Disable the Upload Command Button.

Public Function UploadControl(ByVal frmName As String)
'------------------------------------------------------
'Author   : a.p.r. pillai
'Date     : January-2010
'Remarks  : Data Upload control Routine
'         : All Rights Reserved by www.msaccesstips.com
'------------------------------------------------------
Dim frm As Form, lnglastFileSize, dtlastModified, txtFilePath
Dim lngExternalFileSize, dtExternalModified, authUser
Dim tblControl As String, cmdCtrl As CommandButton

tblControl = "UploadCtrl"
authUser = "LizzaMinnelli"
Set frm = Forms(frmName)
Set cmdCtrl = frm.Controls("cmdUpload")

'Read last recorded information from the Control Table
lnglastFileSize = DLookup("FileLen", tblControl)
dtlastModified = DLookup("FileDateTime", tblControl)
txtFilePath = DLookup("FilePath", tblControl)

'Get the External File information
lngExternalFileSize = FileLen(txtFilePath)
dtExternalModified = FileDateTime(txtFilePath)

If (lngExternalFileSize <> lnglastFileSize) And (dtlastModified <> dtExternalModified) Then
    If CurrentUser = authUser Then
        cmdCtrl.Enabled = True
    Else
        cmdCtrl.Enabled = False
    End If
End If

End Function

The Main SwitchBoard, that has a Command Button with the name cmdUpload, should call the above Program through the Form_Current() Event Procedure of the Form passing the Form Name as Parameter like the following example:

Private Sub Form_Current()
    UploadControl Me.Name
End Sub

If Uploading authority is assigned to a particular User then the Current User's UserID (retrieved with the function CurrentUser) also can be checked with the UserName Field Value before enabling the Command Button cmdUpload..

Share:

Auto Numbering In Query Column

We know how to create an Auto-number Field in a Table to generate Unique Sequence numbers automatically for the records added to the Table. We know how to create Sequence Numbers for data lines on Reports.

On Reports, create a Text Box in Detail Section of the Report, write the expression =1 in the Control Source Property and change the Running Sum Property Value to Over All or Over Group. If you need sequence numbers for each Group separately, depending on the Sorting and Grouping settings on the Report, then the Over Group option must be set in the Property otherwise Over All for continuous numbers from start of the Report to the End.

If you want to create Running Sum value of a Field, like Quantity or Total Price, then set the Running Sum Property value as explained above. For more details on Running Sum as well as creating Page-wise Totals on Access Reports visit the Page with the Title: MS-Access Report and Page Totals.

But, Auto-numbering in Queries looks somewhat strange to ask for unless you want to use the Query result for display purposes or the output created from that should have sequence numbers for some reason. Any way this requirement was raised by a participant in a MS-Access Forum on the Net and nobody (including me) could give a clear cut solution except some alternatives. I chipped in with a solution of my own, even though I was not happy with that either.

The Access User who has raised the question in the Forum made direct contact by sending an E-mail to me asking for a solution.

This made me thinking again on that topic and did few trial runs of few simple methods. Finally I could come up with a Function that can do the trick and I am presenting it here so that you can also use it, if you really need it.

It is important to know the usage of the QrySeq() Function in Queries in a new Column to create Sequence Numbers. The Function must be called with few Parameter Values using the values from the Query itself. So, before presenting the VBA Code of the Function I will give some details of the Parameters.

Usage of the Function in the Query Column is as shown below:

SRLNO: QrySeq([ORDERID],"[ORDERID]","QUERY4")

The QrySeq() Function need three Parameters.

  1. The First Parameter must be Unique Values available from any Field in the Query.
  2. Second Parameter is the Column Name of the first parameter in Quotes.
  3. Third Parameter is the Name of the Query from where you call the Function.

The Query, from where the QrySeq() Function is called should have a column of Unique Values, like Autonumber or Primary Key Field. If this is not readily available then create a Column by joining two or more existing fields (like NewColumn:([OrderlD] & [ShippName] & [RequiredDate] & [Quantity] from the existing column values and ensure that this will form Unique values in all records and pass this Column value ([NewColumn]) as first Parameter.

The first Parameter Column Name must be passed to the Function in Quotes ("[NewColumn]") as second parameter.

The Name of the Query must be passed as third parameter.

NB: Ensure that you save the Query first, after every change to the design of the Query, before opening it in Normal View, with the Function in place, to create the Sequence Numbers correctly.

Now, the simple Rules are in place it is time to try out the Function.

  1. Copy and Paste the following VBA Code into a Standard Module in your Database:
    Option Compare Database
    Option Explicit
    
    Dim varArray() As Variant, i As Long
    
    Public Function QrySeq(ByVal fldvalue, ByVal fldName As String, ByVal QryName As String) As Long
    '-------------------------------------------------------------------
    'Purpose: Create Sequence Numbers in Query in a new Column
    'Author : a.p.r. pillai
    'Date : Dec. 2009
    'All Rights Reserved by www.msaccesstips.com
    '-------------------------------------------------------------------
    'Parameter values
    '-------------------------------------------------------------------
    '1 : Column Value - must be unique Values from the Query
    '2 : Column Name  - the Field Name from Unique Value Taken
    '3 : Query Name   - Name of the Query this Function is Called from
    '-------------------------------------------------------------------
    'Limitations - Function must be called with a Unique Field Value
    '            - as First Parameter
    '            - Need to Save the Query after change before opening
    '            - in normal View.
    '-------------------------------------------------------------------
    Dim k As Long
    On Error GoTo QrySeq_Err
    
    restart:
    If i = 0 Or DCount("*", QryName) <> i Then
    Dim j As Long, db As Database, rst As Recordset
    
    i = DCount("*", QryName)
    ReDim varArray(1 To i, 1 To 3) As Variant
    Set db = CurrentDb
    Set rst = db.OpenRecordset(QryName, dbOpenDynaset)
    For j = 1 To i
        varArray(j, 1) = rst.Fields(fldName).Value
        varArray(j, 2) = j
        varArray(j, 3) = fldName
        rst.MoveNext
    Next
    rst.Close
    End If
    
    If varArray(1, 3) & varArray(1, 1) <> (fldName & DLookup(fldName, QryName)) Then
        i = 0
        GoTo restart
    End If
    
    For k = 1 To i
    If varArray(k, 1) = fldvalue Then
        QrySeq = varArray(k, 2)
        Exit Function
    End If
    Next
    
    QrySeq_Exit:
    Exit Function
    
    QrySeq_Err:
    MsgBox Err & " : " & Err.Description, , "QrySeqQ"
    Resume QrySeq_Exit
    
    End Function
  2. Import the Orders Table from C:\Program Files\Microsoft Office\Office11\Samples\Northwind.mdb sample database.
  3. Copy and Paste the following SQL String into the SQL Editing View of a New Query and save the Query with the Name: AutoNumberQuery:
    SELECT Orders.*, QrySeq([OrderID],"OrderID","AutoNumberQuery") AS SRLNO
    FROM Orders;
    
  4. Select Save from File Menu or click on the Save Toolbar Button.
  5. Open the Query in normal view.

Check the SRLNO Column for Sequence Numbers.

Here, the OrderID in the Orders Table have unique field values and we could easily get away with the Sequence Numbers correctly in SRLNO Column.

Let us pretend for a moment that we don't have a single field with Unique Values in the Query. We must create a Column with Unique Values by joining two or more Columns available in the Query and pass it to the QrySeq() Function.

Let us try such an example with the Orders Table.

  1. Copy and Paste the following SQL String into a new Query and Save the Query with the name AutoNumberQuery2.
    SELECT Orders.*, [ShipName] & [RequiredDate] AS NewColumn, QrySeq([NewColumn],"NewColumn","AutoNumberQuery2") AS SRLNO
    FROM Orders;
  2. Open the Query in normal View to check whether the Serial Numbers were created correctly or not.

When there are several records it is difficult to check whether the Column Values we have passed to the Function are really unique and the Serial Numbers generated have no duplicates in them by manually checking through the records. Instead, we will take a Count of Serial Numbers appearing more than once in the Records, if any, with the use of a Total Query using AutoNumberQuery2 as Source.

  1. Create a new Query using the following SQL String and name the new Query as DuplicatesCheckQ:
    SELECT AutoNumberQuery2.SRLNO,
     Count(AutoNumberQuery2.SRLNO) AS CountOfSRLNO
    FROM AutoNumberQuery2
    GROUP BY AutoNumberQuery2.SRLNO
    HAVING (((Count(AutoNumberQuery2.SRLNO))>1));
    
  2. Open DuplicatesCheckQ Query in Normal View.

You will find the following result showing SRLNO Column having the same number appearing more than once in the records indicating that the Unique Column Values we have created for the Function are not really Unique and have duplicates in them.

This can be rectified only by adding more Column Values to the NewColumn expression to eliminate the chance of ending up with duplicates.

This method is only an alternative in the absence of an AutoNumber or Primary Key field Values and not with 100% percent success rate because when you add more records to the Source Table it is likely that it can fail again. In this case the only solution is to join more fields to the expression in NewColumn so that we can reduce the chance of failures.

Now, to correct the above Query add the [Freight] Value Column also to the NewColumn expression. Or Copy and paste the following SQL String into the AutoNumberQuery2 Query overwriting the earlier SQL string in there and save the Query.

SELECT Orders.*,
 [ShipName] & [RequiredDate] & [Freight] AS NewColumn,
 QrySeq([NewColumn],
"NewColumn";,"AutoNumberQuery2") AS SRLNO
FROM Orders;

Open the DuplicatesCheckQ Query again to check for duplicates. If the result is empty then the Sequence Numbers generated will be correct.

If you have a different solution to this problem, then share it with me too. I don't need a refined version of the above Code or method but a different approach to arrive at the same or better result.




Download Demo QryAutoNum.zip



Share:

Translate



PageRank
Your email address:

Delivered by FeedBurner

Search

Infolinks Text Ads


Blogs Directory

Popular Posts

Search This Blog

Blog Archive

Powered by Blogger.

Labels

Forms How Tos Functions MS-Access Security Reports msaccess forms Animations msaccess animation Utilities msaccess controls Access and Internet MS-Access Scurity MS-Access and Internet Queries External Links msaccess reports msaccess tips Menus and Toolbars Accesstips MsaccessLinks Process Controls Art Work Downloads msaccess How Tos Graph Charts msaccessQuery List Boxes Command Buttons Emails and Alerts Query Combo Boxes Custom Wizards DOS Commands ms-access functions msaccess functions msaccess graphs msaccess reporttricks msaccessprocess security advanced Access Security Array Custom Functions Data Macros Menus Property Report Top Values VBA msaccess email msaccess menus progressmeter Access2007 Auto-Number Command Button Copy Form Join Microsoft Numbering System Records Security Split SubForm Table Utility Variables Workgroup database msaccess wizards Access2003 Accounting Year Action Animation Attachment Binary Numbers Bookmarks Budgeting Calculation ChDir Color Palette Conditional Formatting Controls Data Filtering Data Type Defining Pages Diagram Disk Dynamic Lookup Error Handler Excel Export Expression External Field Type Fields Filter Form Instances Formatting Groups Hexadecimal Numbers Import Labels List Logo Macro Mail Merge Main Form Memo Methods Monitoring Object Reference Objects Octal Numbers Operating System Paste Primary-Key Product Rank Reading Recordset Rich Text Sequence SetFocus Summary Tab-Page Tables Time Difference Union Query User Users Water-Mark Word automatically commands function hyperlinks iSeries Date iif ms-access msaccess msaccess alerts pdf files reference restore switch text toolbar tutorial updating upload vba code

Featured Post

Function Parameter Array Passing

Last week we have explored the usage of ByVal (By Value) and ByRef (By Reference),  in the Function Parameter, to pass the value from  a Va...

Labels

Blog Archive

Recent Posts