Rounding Function MRound of Excel

Normally we round numbers in calculations when the fractional part is 0.5 or more to 1 (next highest integer) or truncate it altogether. But, there are times that this fractional part itself to be rounded to a certain level so that it can be used for disbursement of money, like wages.


For example, in Currencies when the value ends up in 15 cents, 30 cents they should be rounded to 25 cents, 50 cents respectively for determining the requirement of correct number and denominations of Coins for disbursement. If we decide we need only 50 Cents Coins then a value of 25 Cents or more should be rounded to 50 Cents and less than 25 Cents to zero.


So, we need a function that can accept a value as precision and find multiples of that value and when the remainder value is half or more of the precision value it should be rounded to the next level. Not necessary that it should be a fractional value it can be any value as precision.








In MS-Access we have Round() Function that will only round the Double Precision numbers into the required number of Decimal Places or to the next integer level applying the normal rules that we are already familiar. There is a Worksheet Function MRound() in MS-Excel that can do these kind of calculations, but found nothing like that in MS-Access. We cannot go to Excel when we want this in Access.


We will write a MRound() Function in Access with the same name.


So here it is:

Public Function MRound(ByVal Number As Double, ByVal Precision As Double) As Double
Dim Y As Double

On Error GoTo MRound_Err

   Y = Int(Number / Precision) * Precision
   MRound = IIf(((Number - Y) / Precision * 100 + 0.1) >= 50, Y + Precision, Y)

MRound_Exit:
Exit Function

MRound_Err:
MsgBox Err.Description, , "MRound()"
MRound = 0
Resume MRound_Exit
End Function

Copy and paste the above Code into a Global Module of your Database and save the Module.


Open the Debug Window (Ctrl+G) to try it out directly.



Sample Runs:

? Mround(123.3,.2)

Result: 123.4

? Mround(123.24,.5)

Result: 123

? Mround(123.25,.5)

Result: 123.5

? Mround(123.74,.5)

Result: 123.5

? Mround(123.75,.5)

Result: 124

? Mround(10,3)

Result: 9

? Mround(11,3)

Result: 12

If you would like to share this Function across your Other MS-Access Databases then create a Library Database with the Function in it and set a Reference to the Library Database through Tools- ->References in VBA Window.

---

No Data and Report Error
Lost Links of External Tables
Link External Tables with VBA
Source Connect Str Property and ODBC
Access Live Data in Excel-2

Sum Min Max Avg ParamArray

I know your immediate response after looking at the Title will be, "I know all those things, tell me something that I don't know". Well, if you haven't come across the last item (that is an odd one) in the Title before, then that is what I am trying to do here, read on. The first four words are very familiar to us they are Built-in Functions in MS-Access and Worksheet Functions in Excel.


We will catch up with the last one later, after checking the usage of Min() Function (will represent the first four items in the title) in Excel and why we have some difficulty with it in MS-Access when compared with Microsoft Excel.


We are not forgetting the other Functions DCount(), DSum(), DMin(), DMax() and DAvg() of Access at all.


Let us look at the usage of Min() Worksheet Function in Excel. It can find the minimum Value from a Range of Cells in a single Column, from a Row of Cells across Columns or from a Range of Cells spread over several Columns and Rows.



But, when we come back to MS-Access the Min() Function can be used only in a single column (on a single Field) of Data in Query and in Header/Footer Sections of Forms or Reports. Then what do we do to find the Minimum value from more than one Field of data?


Have a look at the sample Table given below to get the gravity of the issue we are in here.



We have received Quotations for Electronic Items from three different Suppliers and we need to know which one is the lowest and from which Supplier? In this case our Min() Function has no use here unless we re-organize the above data into the following format:





To get the required result out this data we need two Queries and we will ignore the duplication of Descriptions, Supplier Names and the Table size in Records etc. for now.

1. Need one Total Query to group on Desc field and the Min() Function to find the minimum Value from the Values Field.


2. Need a second Query, using the first Query and the Table above as Source, JOINed on Desc and MinOfValues Columns of the Total Query with the Desc and Values Fields of the Table to pick all the records from the Table matching with minimum quoted values and Description.

I consider these steps are excessive work and I know you will agree too. Instead, we can write a User Defined Function with the use of ParamArray and pass the Field Names to the Function and find the Minimum Value from the list. Here is a simple Function with the use of ParamArray declaration to find the Minimum Value from a List of Values passed to it.

Public Function myMin(ParamArray InputArray() As Variant) As Double
'------------------------------------------------------------------
'Author : a.p.r. pillai
'Date   : November-2008
'URL    : www.msaccesstips.com
'All Rights Reserved by www.msaccesstips.com
'------------------------------------------------------------------
Dim arrayLength As Integer, rtn As Double, j As Integer

'calculate number of elements in Array
arrayLength = UBound(InputArray())

'initialize Null values to 0
For j = 0 To arrayLength
   InputArray(j) = Nz(InputArray(j), 0)
Next
'initialize variable with 1st element value
'or if it is zero then a value with high magnitude
rtn = IIf(InputArray(0) = 0, 9999999999#, InputArray(0))

For j = 0 To arrayLength
    If InputArray(j) = 0 Then GoTo nextitem
    If InputArray(j) < rtn Then
        rtn = InputArray(j)
    End If
nextitem:
Next

myMin = rtn
End Function 

Copy and Paste the above Code into a Global Module and save it.


Few simple rules must be kept in mind while writing User Defined Functions using the ParamArray declaration in the Parameter list of the Function.

1. While declaring the Function, the Parameter Variable InputArray() (or any other name you prefer) must be declared with the keyword ParamArray, in place of ByRef or ByVal we normally use to declare parameters to functions.


2. The Data Type must be Variant.


3. The ParamArray declaration must be the last item in the Parameter list if the UDF accepts more than one Parameter.


4. The Optional parameter declarations should not appear before the ParamArray declaration.


5. Since the data type is Variant it can accept any type of values.

With the use of the above myMin() Function we have created a Query on the first Table given above. The SQL and the result image of the Query in Datasheet View are given below.

SELECT MaterialQuote.Desc, 
MaterialQuote.Supplier1, 
MaterialQuote.Supplier2, 
MaterialQuote.Supplier3, 
mymin([supplier1],[supplier2],[supplier3]) AS Minimum, 
IIf([minimum]=[supplier1],"Supplier1",IIf([minimum]=[supplier2],"Supplier2",IIf([minimum]=[supplier3],"Supplier3",""))) AS Quote
FROM MaterialQuote;

In the above example we have used only three Field Values to pass to the Function and these can vary depending on your requirement.


A modified version of the same Function is given below that accepts a Calculation Type value (range 0 to 3) as first Parameter and depending on that we can find Summary, Minimum, Maximum, or Average of values passed to it through the InputArray() Variable.

Public Function SMMAvg(ByVal calcType As Integer, ParamArray InputArray() As Variant) As Double
'------------------------------------------------------------------------
'calType : 0 = Summary
'        : 1 = Minimum
'        : 2 = Maximum
'        : 3 = Average
'------------------------------------------------------------------------
'Author  : a.p.r. pillai
'Date    : November 2008
'URL     : www.msaccesstips.com
'All Rights Reserved by www.msaccesstips.com
'------------------------------------------------------------------------
Dim rtn, j As Integer, arrayLength As Integer
Dim NewValue As Variant

On Error GoTo SMMAvg_Err

If calcType < 0 Or calcType > 3 Then
     MsgBox "Valid calcType Values 0 - 3 only", , "SMMAvg()"
     Exit Function
End If

arrayLength = UBound(InputArray())
For j = 0 To arrayLength
   InputArray(j) = Nz(InputArray(j), 0)
Next

Select Case calcType
    Case 1
        rtn = InputArray(0)
        rtn = IIf(rtn = 0, 9999999999#, rtn)
    Case 2
        rtn = InputArray(0)
    Case Else
        rtn = 0
End Select

For j = 0 To arrayLength
    NewValue = InputArray(j)
    If NewValue = 0 Then GoTo nextitem
    Select Case calcType
        Case 0, 3
            rtn = rtn + NewValue
        Case 1
            rtn = IIf(NewValue < rtn, NewValue, rtn)
        Case 2
            rtn = IIf(NewValue > rtn, NewValue, rtn)
    End Select
nextitem:
Next

If calcType = 3 Then
   rtn = rtn / (arrayLength + 1)
End If

SMMAvg = rtn

SMMAvg_Exit:
Exit Function

SMMAvg_Err:
MsgBox Err.Description, , "SMMAVG()"
SMMAvg = 0
Resume SMMAvg_Exit

End Function 

The Function name was defined using the first letters of the Calculation Types that the Function can perform and I hope you like it too.


When any of the values in the InputArray() element is Zero then that is ignored and will not be taken as minimum value.


We can use this Function in Text Boxes on Forms or Reports by passing Values from other Controls. Use it at your own risk.

---

Access Live Data in Excel-2
MS-Access Live Data in Excel
Database Connection String Properties
Opening Excel Database Directly
Display Excel Value Directly on Form

MICROSOFT ACCESS HOW TOS

IMPLEMENTING MICROSOFT ACCESS SECURITY

• MICROSOFT ACCESS SECURITY OVERVIEW
• Creating a User Account
• Creating a Group Account
  
• Add Users to Security Groups
• Remove Users from Security Groups
• Deleting a User-Account
• Deleting a User-Group-Account
• Create or Change Security Password
• Clear Security Password
• Assign or Remove Permissions
• Assign Default Permissions
• View/Transfer Ownership of Objects
• Transfer Ownership of Database
• Set Permissions to Run/View Query
• Default Permissions for new Query
• RunPermissions Property
• Converting Database Old-Versions
• Converting Old-Version Workgroup File
• Sharing Previous Version Database
  

TIPS & TRICKS

Command Button Animation

Creating 3D Text on Forms/Reports

Creating 2D Text with Borders on Forms/Reports

Creating 3D Text with Borders on Forms/Reports

Creating 3D Text with customizable Shadow setting

Using Office-Assistant with MessageBox

How to use Common Dialogue Control (File Browser) in MS-Access

How to create a Reminder Ticker on Form

How to Import/Export Microsoft Access Objects using VB Code.

How to Create an Excel File from Microsoft Access and write data into it.

How to create a Word File from Microsoft Access and write text into it.

How to create a Text File using FileSystemObject.

How to Rename File using FileSystemObject.

How to display Drive, Folder and File information using FileSystemObject.

DISPLAY PATH AND FILE INFO

Displaying Path & File Info

Sub ShowFileAccessInfo2()
Dim fs, d, f, s

On Error Goto ShowFileAccessInfo2_Err

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.Getfile("C:\mytext.txt")

s = UCase(f.Path) & vbCrLf
s = s & "Created: " & f.DateCreated & vbCrLf
s = s & "Last Accessed: " & f.DateLastAccessed & vbCrLf
s = s & "Last Modified: " & f.DateLastModified & vbCrLf
s = s & "File Size : " & f.Size & " Bytes."

MsgBox s, 0, "File Access Info"

ShowFileAccessInfo2_Exit:
Exit Sub

ShowFileAccessInfo2_Err:
MsgBox Err.Description,,"ShowFileAccessInfo2"
Resume ShowFileAccessInfo2_Exit

End Sub

Courtesy: Microsoft Access Help Documents.

Next >> HOW TOs Main Page

RENAME FILE USING FILESYSTEMOBJECT

Renaming a file and displaying Drive & File Information

Sub ShowFileAccessInfo()
Dim fs, f, s

On Error GoTo ShowFileAccessInfo_Err

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.Getfile("C:\mytext.txt")
s = f.Name & " on Drive " & UCase(f.Drive) & vbCrLf

'renames the file named c:\mytext.txt as yourtext.txt

f.Name = "yourtext.txt"
s = s & "New Name: " & f.Name & vbCrLf
s = s & "Created: " & f.DateCreated & vbCrLf
s = s & "Last Accessed: " & f.DateLastAccessed & vbCrLf
s = s & "Last Modified: " & f.DateLastModified

MsgBox s, 0, "File Access Info"

ShowFileAccessInfo_Exit:
Exit Sub

ShowFileAccessInfo_Err:
MsgBox Err.Description, , "ShowFileAccessInfo"
Resume ShowFileAccessInfo_Exit

End Sub

Next >> Display Path and File Info.

CREATE TEXT FILE FROM MSACCESS

HOW TO CREATE A TEXT FILE FROM MICROSOFT ACCESS

The FileSystemObject Object provides access to a the computer’s file system.

The following code illustrates how the FileSystemObject is used to return a TextStream object that can be read from or written to:

Syntax : Scripting.FileSystemObject

Example:

Sub CreateTextFile()
Dim fs As Object, a

On Error goto CreateTextFile_Err

Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("C:\mytest.txt", True)
a.writeline ("This is a test.")
a.Close

CreateTextFile_Exit:
Exit Sub
CreateTextFile_Err:
Msgbox Err.Description,,"CreateTextFile"
Resume CreateTextFile_Exit

End Sub

In the code shown above, the CreateObject function returns the FileSystemObject (fs). The CreateTextFile method then creates the file as a TextStream object (a), and the WriteLine method writes a line of text to the created text file. The Close method flushes the buffer and closes the file.

Reading Text File using FileSystemObject Example:

Sub ReadTextFile()
Dim fs As Object, a, txtline

On Error Goto ReadTextFile_Err

Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.opentextfile("C:\mytest.txt")
txtline = a.readline
a.Close

MsgBox "C:\mytest.txt File contents : " & txtline

ReadTextFile_Exit:
Exit Sub

ReadTextFile_Err:
Msgbox Err.Description,,"ReadTextFile"
Resume ReadTextFile_Exit

End Sub

Next >> Rename File

CREATE EXCEL WORD FILE FROM ACCESS

CREATE EXCEL OR WORD FILE FROM ACCESS

Create Excel File or Word Document from Microsoft Access and write information into them. Every application that supports Automation provides at least one type of object. For example, a word processing application may provide an Application object, a Document object and a Toolbar object. To create an ActiveX object, assign the object returned by CreateObject to an object variable. The first example creates a Word File and writes some text into it and saves with a name.

Public Sub CreateWordDoc()
Dim WordObj As Object

On Error goto CreateWordDoc_Err

Set WordObj = CreateObject("word.application")
WordObj.Application.Visible = True
WordObj.Application.Documents.Add "Normal", , 0, True
WordObj.ActiveDocument.Content = "THIS IS MY TEST DOCUMENT."
WordObj.Application.ActiveDocument.SaveAs "C:\myDocument2.doc"
WordObj.Application.Quit

Set WordObj = Nothing
CreateWordDoc_Exit:
Exit Sub

CreateWordDoc_Err:
msgbox Err.Description,,"CreateWordDoc"
Resume CreateWordDoc_Exit

End Sub

The Next example creates an Excel Worksheet and writes a line of text in Column A, Row 1 and saves it with a Name. This code starts the application creating the object, in this case, a Microsoft Excel spreadsheet. Once an object is created, you reference it in code using the object variable you defined. You access properties and methods of the new object using the object variable, ExcelSheet and other Microsoft Excel objects, including the Application object and the Cells collection.

Public Sub CreateExcelSheet()
Dim ExcelSheet As Object

On Error goto CreateExcelSheet_Err

Set ExcelSheet = CreateObject("Excel.Sheet") _
ExcelSheet.Application.Visible = True

ExcelSheet.Application.Cells(1, 1).Value = "This is Column A, _
row 1"ExcelSheet.SaveAs "C:\TEST.XLS"
ExcelSheet.Application.Quit

Set ExcelSheet = Nothing

CreateExcelSheet_Exit:
Exit Sub

CreateExcelSheet_Err:
Msgbox Err.Description,,"CreateExcelSheet"
Resume CreateExcelSheet_Exit

End Sub

Next >> Create Text File from Access.

IMPORT OBJECTS WITH VBCODE

IMPORT OBJECTS WITH VISUAL BASIC CODE

Normally, Tables, Queries or other objects from another database can be imported manually by selecting Import from Get External Data option from File menu. But this can be achieved through VB Code too and this question, HOW TO? is raised in Microsoft Access User’s Forums and I thought it is useful to those who look for this solution. Hence, I present the Code here for importing Tables, Queries and Forms separately.

The next method imports all Tables from a Source database into the active database except the Microsoft Access System Tables.

Public Function TableImport()
'-----------------------------------------------------------------
'Function to Import Microsoft Access Tables from another Database
'Author : a.p.r. pillai
'Date : 02/12/2006
'-----------------------------------------------------------------
Dim wrkSpace As Workspace, db As Database, tbldef
Dim strFile As String
Dim ObjFilter As String

'if conflict with existing object name then ignore
' and import next object
On Error Resume Next

Set wrkSpace = DBEngine.Workspaces(0)

'Check for Table Definitions in the Source database
'and import all of them except System Tables.

Set db = wrkSpace.OpenDatabase("c:\tmp\Sourcedb.mdb")
For Each tbldef In db.TableDefs
strFile = tbldef.Name

'Filter out Microsoft Access System Tables.
ObjFilter = left(strFile, 4)
If ObjFilter <> "MSys" Then
  DoCmd.TransferDatabase acImport, "Microsoft Access", _
  "c:\tmp\Sourcedb.mdb", acTable, strFile, strFile, False
End If

Next

End Function

Next Function Imports all the Queries from the Source database into the current database.

Public Function QueryImport()
'------------------------------------------------------------------
'Function to Import Microsoft Access Queries from another Database
'Author : a.p.r. pillai
'Date : 02/12/2006
'------------------------------------------------------------------
Dim wrkSpace As Workspace, db As Database, QryDef
Dim strFile As String

'if conflict with existing object name then ignore
'and import next object
On Error Resume Next

Set wrkSpace = DBEngine.Workspaces(0)
'Check for Query Definitions in the Source database
'and import all of them.
Set db = wrkSpace.OpenDatabase("c:\tmp\Sourcedb.mdb")
For Each QryDef In db.QueryDefs
strFile = QryDef.Name
DoCmd.TransferDatabase acImport, "Microsoft Access", _
"c:\tmp\Sourcedb.mdb", acQuery, strFile, strFile, False
Next

End Function

The ImportForms() Function Imports all the Forms from an external Microsoft Access database into the current Database.

Public Function ImportForms()
'----------------------------------------------------------------
'Function to Import Microsoft Access Forms from another Database
'Author : a.p.r. pillai
'Date : 02/12/2006
'----------------------------------------------------------------
Dim FRM As Variant, wrkSpace As Workspace
Dim db As Database, strForm As String
Dim ctr As Container

'if conflict with existing object name then ignore
'and import next object
On Error Resume Next

Set wrkSpace = DBEngine.Workspaces(0)
Set db = wrkSpace.OpenDatabase("c:\tmp\Sourcedb.mdb")
Set ctr = db.Containers("Forms")
For Each FRM In ctr.Documents
strForm = FRM.Name
DoCmd.TransferDatabase acImport, "Microsoft Access", _
"c:\tmp\Sourcedb.mdb", acForm, strForm, strForm, False
Next

End Function

The ExportForms() Function Exports all the Forms into an external Microsoft Access database.

Public Function ExportForms()
'----------------------------------------------------------------
'Function to Export Microsoft Access Forms into another Database
'Author : a.p.r. pillai
'Date : 02/12/2006
'----------------------------------------------------------------
Dim cdb As Database
Dim ctr As Container, doc, strFile As String

'if conflict with existing object name then ignore
'and import next object
On Error Resume Next

'Export all Forms from the current database into 
'the Target database
Set cdb = CurrentDb
Set ctr = cdb.Containers("Forms")

For Each doc In ctr.Documents
strFile = doc.Name
DoCmd.TransferDatabase acExport, "Microsoft Access", _
"c:\tmp\Targetdb.mdb", acForm, strFile, strFile, False
Next

End Function

With little modifications to these Codes, they can be used for transferring objects between two external databases.

Next >> Create Excel File from Access.