Option Compare DatabaseOption Explicit
Private Sub butt1_Click()
DoCmd.GoToRecord , , acFirst
End Sub
Private Sub butt2_Click()
DoCmd.GoToRecord , , acPrevious
End Sub
Private Sub butt3_Click()
DoCmd.GoToRecord , , acNext
End Sub
Private Sub butt4_Click()
DoCmd.GoToRecord , , acLast
End Sub
Private Sub butt6_Click()
DoCmd.GoToRecord , , acNewRec
End Sub
Private Sub Cat_No___UK__Exit(Cancel As Integer)
Dim db As Database
Dim recs As Recordset
Dim ctltext As Control
Dim total As Long, current As Long
Dim testuk As String, testint As String, temp As String
Dim i As Integer
Set db = CurrentDb
Set recs = db.OpenRecordset("main")
current = Forms!main.CurrentRecord
Set ctltext = Forms!main![Cat No (UK)]
ctltext = SetFocus
testuk = ctltext
Debug.Print testuk
Stop
If recs(3) = Null Then
GoTo fin
End If
recs.MoveLast
total = recs.RecordCount
recs.MoveFirst
For i = 1 To total
temp = LCase(recs(3))
Debug.Print testuk, temp
Stop
If testuk = temp Then
testint = "y"
Exit For
End If
recs.MoveNext
Next i
If testint = "y" Then
If MsgBox("Duplicate Cat No!! ", vbOKCancel) = vbOK Then
With recs
.AddNew
recs(3) = ""
.Update
End With
End If
End If
fin:
End Sub
Private Sub catuk_Exit(Cancel As Integer)
End Sub
Private Sub Cat_No__INT__Exit(Cancel As Integer)
Dim db As Database
Dim recs As Recordset
Dim ctltext As Control
Dim testuk As Variant, testint As Variant, temp As Variant
Dim current As Long, total As Long
Dim mess As String
Dim i As Integer
DoCmd.RunMacro "saverec"
Set recs = Me.RecordsetClone()
recs.MoveLast
testuk = recs(4)
If IsNull(testuk) Or (testuk = "") Then
GoTo fin
End If
total = recs.RecordCount
total = total - 1
recs.MoveFirst
For i = 1 To total
temp = recs(4)
'Debug.Print testuk, temp
'Stop
If IsNull(testuk) Then
GoTo bypass
End If
If LCase(testuk) = LCase(temp) Then
testint = "y"
Exit For
End If
recs.MoveNext
bypass:
Next i
If testint = "y" Then
mess = "This is a duplicate Cat No" + Chr(13) + Chr(10) + "Duplicate Record " + Str(i)
If MsgBox(mess, vbOKOnly) = vbOK Then
recs.MoveLast
With recs
.Edit
recs(4) = Null
.Update
End With
End If
'Set ctltext = Forms!main![Cat No (INT)]
'ctltext.SetFocus
End If
recs.Close
fin:
End Sub
Private Sub Cat_No__UK__Exit(Cancel As Integer)
' Dim db As Database
Dim db As DAO.Database
Dim recs As Recordset
Dim ctltext As Control
Dim testuk As Variant, testint As Variant, temp As Variant
Dim current As Long, total As Long
Dim mess As String
Dim i As Integer
DoCmd.RunMacro "saverec"
'Set recs = Me.RecordsetClone()
Set recs = Me.RecordsetClone
'Code added
If recs.RecordCount < 1 Then
MsgBox "No Records were found.", vbCritical, "Exiting Now"
GoTo fin
End If
'end code added
recs.MoveLast
testuk = recs(3)
If IsNull(testuk) Or (testuk = "") Then
GoTo fin
End If
Dim lngCount As Long
total = recs.RecordCount
'temp message box to see what the total is
MsgBox "total = " & total
'end 'temp message box to see what the total is
'' I don't understand why subtract one here
''if you are starting index at 1 and not 0
''so I commented this out
' total = total - 1
recs.MoveFirst
' For i = 1 To total
For lngCount = 1 To total
temp = recs(3)
'Debug.Print testuk, temp
'Stop
'I added check for empty string ""
If IsNull(testuk) Or (testuk = "") Then
GoTo bypass
End If
If LCase(testuk) = LCase(temp) Then
testint = "y"
Exit For
End If
recs.MoveNext
bypass:
Next lngCount
' Next i
If testint = "y" Then
mess = "This is a duplicate Cat No" + Chr(13) + Chr(10) + "Duplicate Record " + Str(i)
If MsgBox(mess, vbOKOnly) = vbOK Then
recs.MoveLast
With recs
.Edit
recs(3) = Null
.Update
End With
End If
'Set ctltext = Forms!main![Cat No (UK)]
'ctltext.SetFocus
End If
recs.Close
fin:
End Sub
Private Sub Distributor_ID_NotInList(NewData As String, Response As Integer)
Dim db As Database
Dim Ctl As Control
Dim fld As Field
Dim tbl As TableDef
Dim recs As Recordset
Dim temp As String
temp = NewData
Set db = CurrentDb
Set recs = db.OpenRecordset("Distributor")
If MsgBox("Data not in list...Add it? ", vbOKCancel) = vbOK Then
Response = acDataErrAdded
With recs
.AddNew
!Distributor = temp
.Update
End With
Else
Response = acDataErrContinue
End If
End Sub
Private Sub Form_Current()
Dim db As Database
Dim current, total As Long
Dim ctltext As Control
Dim recclone As Recordset
Dim intnewrecord As Integer
Set recclone = Me.RecordsetClone()
'recclone.MoveNext
current = Forms!main.CurrentRecord
Set ctltext = Forms!main!Text88
recclone.MoveLast
total = recclone.RecordCount
Set ctltext = Forms!main!Text90
intnewrecord = IsNull(Me.[Stock No])
If intnewrecord Then
butt1.Enabled = True
butt3.Enabled = False
butt2.Enabled = True
butt4.Enabled = True
butt6.Enabled = False
Exit Sub
End If
butt6.Enabled = True
If recclone.RecordCount = 0 Then
butt1.Enabled = False
butt3.Enabled = False
butt2.Enabled = False
butt4.Enabled = False
Else
recclone.Bookmark = Me.Bookmark
recclone.MovePrevious
butt1.Enabled = Not (recclone.BOF)
butt2.Enabled = Not (recclone.BOF)
recclone.MoveNext
recclone.MoveNext
butt4.Enabled = Not (recclone.EOF)
butt3.Enabled = Not (recclone.EOF)
recclone.MovePrevious
End If
recclone.Close
End Sub
Sub Command79_Click()
On Error GoTo Err_Command79_Click
DoCmd.Close
Exit_Command79_Click:
Exit Sub
Err_Command79_Click:
MsgBox Err.Description
Resume Exit_Command79_Click
End Sub
Sub Command80_Click()
On Error GoTo Err_Command80_Click
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70
Exit_Command80_Click:
Exit Sub
Err_Command80_Click:
MsgBox Err.Description
Resume Exit_Command80_Click
End Sub
Private Sub Music_sub_type_ID_NotInList(NewData As String, Response As Integer)
Dim db As Database
Dim Ctl As Control
Dim fld As Field
Dim tbl As TableDef
Dim recs As Recordset
Dim temp As String
temp = NewData
Set db = CurrentDb
Set recs = db.OpenRecordset("Music Sub-type")
If MsgBox("Data not in list...Add it? ", vbOKCancel) = vbOK Then
Response = acDataErrAdded
With recs
.AddNew
![Music Sub-type] = temp
.Update
End With
Else
Response = acDataErrContinue
End If
End Sub
Private Sub Music_type_ID_NotInList(NewData As String, Response As Integer)
Dim db As Database
Dim Ctl As Control
Dim fld As Field
Dim tbl As TableDef
Dim recs As Recordset
Dim temp As String
temp = NewData
Set db = CurrentDb
Set recs = db.OpenRecordset("Music Type")
If MsgBox("Data not in list...Add it? ", vbOKCancel) = vbOK Then
Response = acDataErrAdded
With recs
.AddNew
![Music Type] = temp
.Update
End With
Else
Response = acDataErrContinue
End If
End Sub
Sub Text88_BeforeUpdate(Cancel As Integer)
End Sub
Sub printrec_Click()
On Error GoTo Err_printrec_Click
Dim db As Database
Dim recs As Recordset
Dim current As Long
Set db = CurrentDb
Set recs = db.OpenRecordset("main")
With recs
End With
Exit_printrec_Click:
Exit Sub
Err_printrec_Click:
MsgBox Err.Description
Resume Exit_printrec_Click
End Sub
Sub printer1_Click()
On Error GoTo Err_printer1_Click
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.PrintOut acSelection
Exit_printer1_Click:
Exit Sub
Err_printer1_Click:
MsgBox Err.Description
Resume Exit_printer1_Click
End Sub
Sub printer2_Click()
On Error GoTo Err_printer2_Click
Dim stDocName As String
stDocName = "label"
DoCmd.OpenReport stDocName, acNormal
Exit_printer2_Click:
Exit Sub
Err_printer2_Click:
MsgBox Err.Description
Resume Exit_printer2_Click
End Sub
Windows 7 32bit 
Access 2010 32bit
Reply With Quote
