Count how many times a value appears in a table…

Ever want to…

• Track how many times the Item has been returned for repairs
• Make sure the Item on the Packing Slip has a valid Return Authorization
• Make that Spare Part hasn’t already been used for another repair

For those times I use…

Place the below code in a Module remembering not to name the Module the same as the Function.  Mine is placed in modUtilities.

Function IDOccurs(strTable As String, lngID As Long) As Integer
On Error GoTo ErrHandler
'From http://www.access-diva.com/vba12.html
'For numeric values</em></span>

Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim myQuery As String

     myQuery = "SELECT * FROM " & strTable & " WHERE lngMyID = " & lngID & ";"

     Set db = CurrentDb()
     Set rst = db.OpenRecordset(myQuery, dbOpenDynaset, dbSeeChanges)

     rst.MoveFirst
     rst.MoveLast

     IDOccurs = rst.RecordCount

Complete:
   Set rst = Nothing
   db.Close
   Set db = Nothing
   Exit Function

ErrHandler:
   MsgBox ("Error:" & Err.Description)
   IDOccurs = True
   Resume Complete
End Function

And here’s an example of its use…  Note: UpdateUser() is shown below.

Private Sub UpdateUser (strField As String)

Dim strID As String
Dim lngRecordIDs As Long

If strField = "rID" Then
     Me.txtID.SetFocus
     strID = Me.txtID
     lngRecordIDs = IDOccurs("tblReceiving", CLng(strID))
Else
     lngRecordIDs = IDOccurrences("tblReceiving", "SerialNumber", strID)
End If

   Select Case lngRecordIDs
     Case 0
      lblUpdate.Caption = "Item has not been received."
      lblUpdate.ForeColor = vbRed
     Case 1
      lblUpdate.Caption = "Item has been received 1 time."
      lblUpdate.ForeColor = vbBlack
     Case Else
      lblUpdate.Caption = "Item has been received " & Trim(Str(lngRecordIDs)) & " times!"
      lblUpdate.ForeColor = vbRed
   End Select

End Sub

Place the below code in a Module remembering not to name the Module the same as the Function.  Mine is placed in modUtilities.

Function IDOccurrences(strTable As String, strField, strID As String) As Integer
On Error GoTo ErrHandler
'From http://www.access-diva.com/vba12.html
'For string values

Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim myQuery As String

     myQuery = "SELECT * FROM " & strTable & " WHERE " & strField & " = '" & strID & "';"

     Set db = CurrentDb()
     Set rst = db.OpenRecordset(myQuery, dbOpenDynaset, dbSeeChanges)

     If rst.RecordCount = 0 Then
        rst.MoveLast
        rst.MoveFirst
     End If

     IDOccurrences = rst.RecordCount

Complete:
   Set rst = Nothing
   db.Close
   Set db = Nothing
Exit Function

ErrHandler:
   MsgBox ("No occurences with that ID found!")
   IDOccurrences> = True
   Resume Complete
End Function

And here’s an example of its use…  Notice it is the the BeforeUpdate event of Serial Number.  This is to capture the event while it’s being entered and before it’s commited to the table.  Now, we can quickly Undo should the answer to the question be no.

Private Sub txtSerialNumber_BeforeUpdate(Cancel As Integer)

Dim intResp As Integer

  If IDOccurrences("tblReceiving", "rSerialNumber", Me.txtSerialNumber) = 1 Then
     Me.txtSerialNumber.ForeColor = RGB(193, 0, 0)
     DoCmd.OpenForm "frmViewUnit", , , "[rSerialNumber]='" & Me![txtSerialNumber] & "'", , acDialog 

        intResp = MsgBox("Serial Number" & Me.txtSerialNumber & " already exists in Receiving table! Continue anyway?", " & _
                                                 vbYesNo + vbExclamation, "Serial Number")

      If intResp = vbYes Then
            Me.txtSerialNumber.ForeColor = RGB(0, 0, 0)
       Else
           Cancel = True
           Me.Undo
      End If
   End If

End Sub

Here’s another sample of how I use UpdateUser() when the processing of data is going to take a few mintes.  I can then let them know what’s going on so they don’t get over anxious with the mouse while waiting for the process to finish…

Private Sub UpdateUser(strMsg As String)
     lblUpdate.Caption = strMsg
     Me.Repaint
     DoEvents
End Sub

Legend…

dbSeeChanges only needed if you’re using tables linked to an SQL Server, otherwise you can omit.

 992 total views,  1 views today