How to build a Count Querie for VBA code

[war6000]

I'm fixing a software from an old source code. the code is here but the query in the database is not there anymore. I just want the software to keep adding a number every time i input a two customers with the same name. This is the code i have on the source


Private Sub cmdCheck_Click()
Dim q As QueryDef
Dim rs As Recordset
Dim CountStr As String
Dim Count As Long
If Len(txtFirstName) = 0 Then
MsgBox "Please enter a first name", vbCritical, "F-Miracle"
Exit Sub
End If

If Len(txtLastName) = 0 Then
MsgBox "Please enter a last name", vbCritical, "F-Miracle"
Exit Sub
End If


Set q = CurrentDB.QueryDefs("int_qGetCodeCount")
q.Parameters("pCode") = UCase(MakeCode)
Set rs = q.OpenRecordset

If rs.RecordCount = 0 Then
Count = 1
Else
Count = rs("MaxCode") + 1
End If
CountStr = Format(Count, "000")
txtCode = UCase(MakeCode) & CountStr
cmdSave.Enabled = True

End Sub

[westconn1]

what is makecode?

[war6000]

I dont really know what it means but i think is the first name and last name

Wilfredo Romero

ROMEWIL

and i want to add the counter at the end

ROMEWIL001

and if i add a new client with the same name, I want the software to give me this

ROMEWIL002

and so on. Thank you very much

[westconn1]

i am not experienced with parameters, but i think it would need to be something like
q.Parameters("pCode") Like UCase(MakeCode) & "*"
to return all records that match the makecode and any suffix
you can then use the recordcount of the recordset to work out the next suffix
countstr = format(rs.recordcount) + 1,"000")

i am not sure if the parameters is correct, search on parameters like for examples, here, database forum or google

[war6000]

This is the code for the frame "addCustomer"(red part) the count section is not working. It is only adding a 001 to every customer even if the have the same name

Option Explicit
Public boolCancled As Boolean
Public NewCustomerID As Long
Public NewFirstName As String
Public NewLastName As String
Public NewSSN As String
Public NewAddress As String
Public NewTransferedDate As Date


Private Sub cmdCancel_Click()
boolCancled = True
Hide
End Sub



Public Function MakeCode() As String
Dim lastpart As String
Dim firstpart As String
Dim i As Long

If Len(txtLastName) < 4 Then
lastpart = txtLastName
For i = 1 To 4 - Len(txtLastName)
lastpart = lastpart & "0"
Next i
Else
lastpart = Left(txtLastName, 4)
End If

If Len(txtFirstName) < 2 Then
firstpart = Me.txtFirstName

For i = 1 To 2 - Len(txtFirstName)
firstpart = firstpart & "0"
Next i
Else
firstpart = Left(txtFirstName, 2)
End If

MakeCode = lastpart & firstpart

End Function



Private Sub cmdCheck_Click()
Dim q As QueryDef
Dim rs As Recordset
Dim CountStr As String
Dim Count As Long
If Len(txtFirstName) = 0 Then
MsgBox "Please enter a first name", vbCritical, "F-Miracle"
Exit Sub
End If

If Len(txtLastName) = 0 Then
MsgBox "Please enter a last name", vbCritical, "F-Miracle"
Exit Sub
End If


Set q = CurrentDB.QueryDefs("int_qGetCodeCount")
q.Parameters("pCode") = UCase(MakeCode)
Set rs = q.OpenRecordset

If rs.RecordCount = 0 Then
Count = 1
Else
Count = rs("MaxCode") + 1
End If

CountStr = Format(Count, "000")
txtCode = UCase(MakeCode) & CountStr
cmdSave.Enabled = True



End Sub

Private Sub cmdSave_Click()
Dim rs As Recordset

On Error Resume Next
On Error GoTo 0
Set rs = CurrentDB.OpenRecordset("tblCustomer")
rs.AddNew
rs("FirstName") = txtFirstName
rs("LastName") = txtLastName
rs("Code") = txtCode
rs("Middle") = txtMiddle
rs("DateOfTransferToLegal") = txtTransfered
rs("EmployeeID") = CurrentEmp.EmployeeID
rs.Update
rs.Bookmark = rs.LastModified



NewCustomerID = rs("CustomerID")
NewFirstName = txtFirstName
NewLastName = txtLastName
NewSSN = ""
NewAddress = ""
NewTransferedDate = txtTransfered



boolCancled = False
Hide

End Sub

Private Sub Form_Activate()
cmdSave.Enabled = False
txtFirstName = ""
txtLastName = ""
txtCode = ""
txtTransfered.Value = Now()
txtMiddle = ""
txtFirstName.SetFocus
boolCancled = True

End Sub

Private Sub Form_Load()
boolCancled = True
End Sub



Private Sub txtFirstName_LostFocus()
If txtFirstName = "" Then Exit Sub

If InStr(1, txtFirstName, " ") <> 0 Then
MsgBox "You cannot have spaces in the first name", vbCritical, "F-Miracle"
txtFirstName.SetFocus
End If

' If txtFirstName = UCase(txtFirstName) Then
' MsgBox "Do not use all upper case letters!", vbCritical, "F-Miracle"
' txtFirstName.SetFocus
' End If

txtFirstName = LCase(txtFirstName)
txtFirstName = UCase(Left(txtFirstName, 1)) & Mid(txtFirstName, 2)

End Sub


Private Sub txtLastName_LostFocus()
If txtLastName = "" Then Exit Sub
If InStr(1, txtLastName, " ") <> 0 Then
MsgBox "You cannot have spaces in the last name", vbCritical, "F-Miracle"
txtLastName.SetFocus
End If

' If txtLastName = UCase(txtLastName) Then
' MsgBox "Do not use all upper case letters!", vbCritical, "F-Miracle"
' txtLastName.SetFocus
' End If

txtLastName = LCase(txtLastName)
txtLastName = UCase(Left(txtLastName, 1)) & Mid(txtLastName, 2)

End Sub

[westconn1]

do you check the recordset returned to see if it is not an empty recordset?
afaik it will only return any records if there is an exact match to the parameter
so the most it will return is 1 record

Count = rs("MaxCode") + 1

i have no idea what is in field maxcode, but it does not seem, to me, relevant to this operation, i would assume it would always be 0, empty or null, which is why each new name is added with 001

[war6000]

so what would you do in order to make the application do that counting on the customers that have the same name

[westconn1]

i would use an sql statement if i was doing it

but i don't use access, so the code is different

something like

set rs = currentdatabase.openrecordset("select * from tblCustomer where pcode like '" & ucase(makecode) & "*'"

you would need to test the results
you can also use count, which would only return the number of records, rather than a recordset

but if at any time, any records are deleted you could find that the next number is already used
cust001
cust003
cust004
3 names so next number would be 4, but it already exists

[war6000]

Where in my source code would i be able to paste or replace the line you gave me
1.
set rs = currentdatabase.openrecordset("select * from tblCustomer where pcode like '" & ucase(makecode) & "*'"

[westconn1]

in place of
Set rs = q.OpenRecordset

unfortunately none of the access gurus have jumped in, so i am just trying to make suggestions to help, but i have not used querydef with parameters

[war6000]

I just hope an Access guru to hopefully jump on this and helps me cuz i had no luck on that last post westconn1 thank you very much. im still gonna try to figure this out. Thank you all for the help you have been giving me

[war6000]

does anyone know how to get this done. Previous post did not do the trick

[Siddharth Rout]

@war6000

Let's start from the scratch....

Forget about the code that you have and tell me in simple words what do you want?

[war6000]

I want the software to give each client a unique code (something easier than just numbers)

the old version of the software use to add clients in this format




(first 4 letters of last name) + (first 2 of first name) + (counter)

Romero, Wilfredo

(ROME) + (WI) + (001)

ROMEWI001

[Siddharth Rout]

Fair Enough.

1) Are all these names in the database?
2) Would you be adding new names to the database and do you want to follow the same nomenclature for the new names that will be added later?
3) What would be the scenario if you have names like these...

Romeo, Wild
Romero, Wilde
Romero, Wilfredo
Romeo, Wilfredo

[war6000]

Romeo, Wild
Romero, Wilde
Romero, Wilfredo
Romeo, Wilfredo

as of right now if i was to add those names the software would keep giving me the same code

ROMEWI001

I want the software to keep adding a number every time similar names are inserted. for example

Romeo, Wild ROMEWI001
Romero, Wilde ROMEWI002
Romero, Wilfredo ROMEWI003
Romeo, Wilfredo ROMEWI004

[abhijit]

I want the software to give each client a unique code (something easier than just numbers)

the old version of the software use to add clients in this format




(first 4 letters of last name) + (first 2 of first name) + (counter)

Romero, Wilfredo

(ROME) + (WI) + (001)

ROMEWI001

You're assuming that everyone has at least 4 letters in their first name.
This might not be true.

[war6000]

You're assuming that everyone has at least 4 letters in their first name.
This might not be true.

Majority of our clients have but if they don't the software will add 0's to complete the entry

John Lee
LEE0JO001