I have a table named 'odonto' and it has the fields code (autoincremental), history, surnames and names. I need to generate the code so that it autogenerates the HISTORY obtaining the first letter of the last name which will then have to be concatenated with consecutive numbers for each letter. That is to say that if we have four "FLORES" and a "MENDOZA" in the register it shows in a text box the next samples:
F001
F002
F003
F004
M001
...
Also I need to keep in mind that if a record is deleted it will be replaced by incrementing it again.
I did it and it functions for the asigning value, but it doesn't replace the deleted one if it.
Private Sub APELLIDO_AfterUpdate()
Dim MyStr
MyStr = Left([APELLIDO], 1)
Me.LETRA = MyStr
If IsNull(Me.HISTORIA) Then
Me!HISTORIA = ((MyStr) & "0000" & ([Cant] + 1))
Else
HISTORIA = Me.HISTORIA
End If
Me.Refresh
End Sub
Please your help.
Related
I have autonumber field in MS Access.
Here, it's starting with 1, 2, 3,…
But I want to enumerate numbers starts, with
2017ICLAA001, 2017ICLAA002, 2017ICLAA003,…
How to do that?
Simply type "2017ICLAA"000 into the ID field's Format Property
Should be able to figure out what you want with this since "2017...." is not always going to be the same and if you change it then it will jack up your database.
Example of Year-Number output: 17-0001
When the year changes the number auto resets to 1, because it checks the date then the number value which is incremental from 1 to 9,999 each year. You can delete records and it won't affect numbering since it always checks for the largest integer based on the current year, which is defined by your computers time/clock.
Must have the following columns: [AutonumberID] [DateCreated] [ColumnForYear-Number]
You should set the "[DateCreated]" column's "Default Value" in the Table's DesignView to "=Date()" (without quotes) so a date is added automatically when creating a record.
Add the following to your form's [Event Procedure] BEFOREINSERT otherwise if you update content in the record later (BeforeUpdate) it WILL change the record number everytime a change is made. You've been warned!
Do not use the date of a "[Last Modified]" type of column otherwise you will regret it in the future if you change/update anything in the record when the year changes and edits are made (think about it). Ensure you have a dedicated "[DateCreated]" column that doesn't change after inserting/adding the record no matter what year you decide to make any changes.
Here is the code:
Option Compare Database
Private Sub Form_BeforeInsert(Cancel As Integer)
Dim vLast As Variant
Dim iNext As Integer
vLast = DMax("[ColumnForYear-Number]", "[Table]", "[ColumnForYear-Number] LIKE '" & _
Format([txtDateCreated], "yy\*\'"))
If IsNull(vLast) Then
iNext = 1
Else
iNext = Val(Right(vLast, 4)) + 1
End If
Me![ColumnForYear-Number] = Format([txtDateCreated], "yy") & "-" & Format(iNext, "0000")
End Sub
To get more than 9,999 records in one year change the number 4 in Val(Right(vLast, 4)) to a larger integer, then change the zeros in Format(iNext, "0000") to reflect the number of placeholders. The number 4 and there are four zeros. The same thing applies to the year, just change anywhere there is "yy" to "yyyy" for a four digit year. When making changes ensure the data type for the table's field/column can accept the total characters to be calculated or it will chop off any excess characters. Default is usually 255 characters for text however if your's says 8 characters are allowed for the [ColumnForYear-Number] and you are trying to add 9 or more then you will get frustrated troubleshooting a simple problem. Just FYI.
"[txtDateCreated]" is where the actual date entry exists and not the same as "[DateCreated]" which is the column name, unless you named your label that under the "Other" tab in Property Sheet. In other words columns are [columnname] and the textbox area where values are added/changed/viewed in FORMS should be labeled [txtcolumnname] (minus the brackets of course).
Additional options that are already configured into the format you request are listed in the next response (see below).
Since I had some more time on my hands I decided to answer your question more directly with a couple of options. My assumptions are: (1) You want the year 2017 to change automatically and (2) a prefix you define ICLAA followed by (3) an incremental number 001 that resets with each new year and (4) this is for a form with entry boxes (hence [txt...]).
Table Columns Required:
[AutoNumber] <=Not used here, it's just to show it still exists
[Column4UniqueValue] set the data type to Short Text and ensure your columns field size is set to 12 or more otherwise it will not work and will kick an error.
[DateCreated] set to Date/Time with format as General Date default value set =Date(), set Show Date Picker to Never for good measure, and set Locked value to Yes so user cannot change\override the value in the form. Note: this column [DateCreated] is not required if you decide to go with option two (2) listed below.
After you created the columns above in your table go to your form and add the new fields onto the form, click inside the newly added text field box and set its Other name as txt.... , then go into VBA Code Builder [Alt+F11] and add the code from either option one or option two.
Option One (with DateCreated field):
Private Sub Form_BeforeInsert(Cancel As Integer)
Dim Prefix As String
Dim vLast As Variant
Dim iNext As Integer
Prefix = "ICLAA"
vLast = DMax("[Column4UniqueValue]", "[tblSource]", "[Column4UniqueValue] LIKE '" & Format([txtAreaOfDateCreated], "yyyy\*\") & Prefix & "*'")
If IsNull(vLast) Then
iNext = 1
Else
iNext = Val(Right(vLast, 3)) + 1
End If
Me![txtAreaOfColumn4UniqueValue] = Format([txtAreaOfDateCreated], "yyyy") & Prefix & Format(iNext, "000")
End Sub
Option Two (without DateCreated field):
Private Sub Form_BeforeInsert(Cancel As Integer)
Dim Prefix As String
Dim vLast As Variant
Dim iNext As Integer
Prefix = "ICLAA"
vLast = DMax("[Column4UniqueValue]", "[tblSource]", "[Column4UniqueValue] LIKE '" & Format(Date, "yyyy\*\") & Prefix & "*'")
If IsNull(vLast) Then
iNext = 1
Else
iNext = Val(Right(vLast, 3)) + 1
End If
Me![txtAreaOfColumn4UniqueValue] = Format(Date, "yyyy") & Prefix & Format(iNext, "000")
End Sub
Your end results will look exactly like this 2017ICLAA001 and auto increment each year starting from one. Test it by creating a few records then change your computer's date/time clock to a later or earlier year and add another record. It should change with the year and when the year changes it will auto increment to the next highest value for that year. You can test this by toggling the computer year back and forth just to watch the values remain consistent when you add new records.
I have a Microsoft Access 2013 database that I created to track time. The database has a FINDREPLACE table that I use to store shortcuts for certain often-used time entry text. The table contains two fields, myFind and myReplace. For example, one value in myFind is "telconf" and the corresponding entry in myReplace is "telephone conference with". There is a button on the time entry form that calls a sub that loops through my FINDREPLACE table and replaces all of the shortcut "myFind" text in the time description with the corresponding "myReplace" text. It works well and saves me from having to repeatedly type out the same lengthy phrases or names I can never remember how to spell.
Here is the sub:
Private Sub myFindReplace(myTime As Integer)
Dim dbs As DAO.Database
Dim rs, rs2 As DAO.Recordset
Dim myMsg, mySQL, myTimeString As String
If Me.Dirty Then
myMsg = MsgBox("You must save your record before running FindReplace", vbOKOnly)
Exit Sub
End If
Set dbs = CurrentDb
mySQL = "SELECT * From TABLEFINDREPLACE"
Set rs = dbs.OpenRecordset(mySQL, dbOpenSnapshot)
myTimeString = DLookup("myDESCRIP", "TABLETIME", "ID = " & myTime)
With rs
Do Until .EOF
myTimeString = Replace(myTimeString, !myFind, !myReplace)
.MoveNext
Loop
End With
rs.Close
myTimeString = UCase(Left(myTimeString, 1)) & Mid(myTimeString, 2)
mySQL = "SELECT * FROM TABLETIME WHERE ID = " & myTime
Set rs2 = dbs.OpenRecordset(mySQL, dbOpenDynaset)
With rs2
.Edit
!myDESCRIP = myTimeString
.Update
End With
rs2.Close
dbs.Close
Me.txtMyDESCRIP.Requery
End Sub
The sub that the button calls uses the VBA Replace function, and it works well in most instances. The problem arises when I want to includes slashes or other special characters in my replace text. For example, one of my "myFind" values is "emailtofrom", and the corresponding "myReplace" value is "e-mail correspondence to/from". But, when I run the sub, the "emailtofrom" text is replaced with "e-mail correspondence tofrom", WITHOUT the slash.
I understand that the VBA Replace function will remove slashes and other special characters. Is there anything that I can do preserve the slashes when the Replace function runs? Escaping the slashes somehow in my FINDREPLACE table (I'm the only one using this database so I can do that if necessary)? Using code other than VBA Replace?
"I understand that the VBA Replace function will remove slashes"
That is not what I see with VBA Replace(). Here are examples from the Immediate window using forward and back slashes.
? Replace("foo emailtofrom bar", "emailtofrom", _
"e-mail correspondence to/from")
foo e-mail correspondence to/from bar
? Replace("foo emailtofrom bar", "emailtofrom", _
"e-mail correspondence to\from")
foo e-mail correspondence to\from bar
I think something else is going on, but I can't spot the issue in your code sample. Set a break point, run your code, and then step through it one line at a time with the F8 key and examine the text values at each step.
My form is hanging for several seconds every time the user goes to a new record. The recordset for a listbox on the form is a query. The form is hanging until that query finishes and the listbox is populated.
My users need to be able to scroll through the records quickly. Currently, the user must wait for the listbox query to finish before moving to the next record. How can I stop the form from hanging?
Is there a way for DoEvents to be used to solve this problem?
Below is my code. I suspect that seeing all this code is not necessary, but I am sharing it all just in case.
I am using Access.
Thanks!
Option Compare Database 'Use database order for string comparisons
Option Explicit
Dim QuoteLogForm As Form
Public KeystrokeCount As Integer
'Define the similarity threshold for the matches list
Const SIMIL_THRESHOLD As Single = 0.83
Private m_strDialogResult As String
'The basis of this code was derived from http://www.accessmvp.com/tomvanstiphout/simil.htm
Private Sub Form_Current()
Matches
End Sub
Private Sub Matches()
'This sub calls the functions necessary to generate a query that lists
'the KFC RFQ #'s whose similarity exceeds the threashold, as defined above.
Dim sql As String
Dim strOpenArgs As String
Dim strInClause As String
'OpenArgs contains the part # to find similars for.
strOpenArgs = Replace(Replace(Nz(Me.Part_Number_Textbox.Value), "-", ""), " ", "") 'Nz changes Nulls to blanks
'Call the GetSimilarPartNos function below.
'This function returns a string of KFC RFQ #'s that exceed the threashold, wrapped in single quotes and separated by commas.
strInClause = GetSimilarPartNos(strOpenArgs)
'If any similar part numbers were found, run a query to select all the listed records
If VBA.Len(strInClause) > 0 Then
'Select records whose KFC RFQ #'s are found in the strInClause list, sort from most to least similar
sql = "select * from [Matches List Query] where [KFC RFQ #] in (" & strInClause & ")" ' order by SimilPct desc, DateShort desc"
'[Forms]![Price Form Parent]![Price Form].[Form].Customer_Filter_Box
Set Me.[Matches List Form].Form.Recordset = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
Else
'If no similar KFC RFQ #'s were found, select no records
sql = "select * from [Matches List Query] where 1 = 0"
Set Me.[Matches List Form].Form.Recordset = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
End If
End Sub
Private Function GetSimilarPartNos(ByVal strPartNo As String) As String
'The GetSimilarPartNos function calls the fnSimil function and compiles a list (strInClause)
'of KFC RFQ #'s whose part numbers exceed the threashold
Dim rs As DAO.Recordset
Dim strInClause As String
Dim sngSimil As Single
'Erase all previous values in the [Quote Log].Simil field
CurrentDb.Execute "update [Quote Log] set Simil = 0", dbFailOnError
Set rs = CurrentDb.OpenRecordset("Quote Log") ', dbOpenTable)
'Loop to calculate the similarity of all part numbers
While Not rs.EOF 'Loop until the end
Dim curPartNo As String
curPartNo = Replace(Replace(Nz(rs![Part #]), "-", ""), " ", "")
If rs![KFC RFQ #] = Me.[KFC RFQ #] Then
GoTo 120
End If
sngSimil = fnSimil(curPartNo, strPartNo)
'If the part number similarity value of a single record is greater than the
'threashold (as defined above), add the record's KFC RFQ # to strInClause
'strInClause forms a list of KFC RFQ #'s whose part numbers exceed the threashold
'in similarity, wrapped in single quotes and separated by commas
If sngSimil >= SIMIL_THRESHOLD Then
strInClause = strInClause & "'" & rs![KFC RFQ #] & "',"
'Show the Simil value on this form
rs.Edit
rs!Simil = sngSimil
rs.Update
End If
120 rs.MoveNext
Wend
rs.Close
Set rs = Nothing
'Once the strInClause is completed, remove the last comma from the list
If Len(strInClause) > 0 Then strInClause = VBA.Left$(strInClause, Len(strInClause) - 1)
GetSimilarPartNos = strInClause
End Function
The UI is hanging because the work is being done by the UI thread. If you want (or need) a more responsive application, you need to offload the work to a background thread. As far as I know, for VBA, that is not something for the feint of heart, but you can take a look, VBA + Threads in MS Access.
As access is a database, it suffers from all the drawbacks of any database, mainly finding data stored on slow, usually spinning, media. I suggest you take a look at this article: Create and use an index to improve performance to help you create efficient indexes for your queries, if you have not indexed for them already. You also need to consider the performance implications of WHERE, JOIN, and ORDER BY clauses in your queries. Make sure your indexes are optimized for your queries and your data is stored in a logical fashion for the way it will be queries out. Beyond that, if the database does not reside on the machine from which the queries are being executed, you have network I/O latency on top of expected Disk I/O latency. This can significantly impact the read performance of the database.
I think you might possibly have the wrong form event.
The form_Current event fires between each record and I can't imagine that's what you really need. Try moving your "Matches" routine into the OnLoad event instead.
Private Sub Form_Current()
Dim bytoffcut As Byte
Dim strCriteria
strCriteria = "[WOID] = " & Forms![frmAddStockBooking]![MouldWO]
bytoffcut = Nz(DMax("OffcutNo", "dbo_tblOffcuts", strCriteria), 0) + 1
MsgBox bytoffcut
Me.txtOffcut.Value = bytoffcut
Me.WOID.Value = Forms![frmAddStockBooking]![MouldWO]
Me.txtdate.Value = Now()
End Sub
Can anyone tell me why this is not working? The variable is behaving as expected where bytoffcut increments by one when i create a new record. But when I check the table the field bound to txtOffcut the field reads 1 instead of the incremented value.
EDIT: This code is being used in the On current property of the form. When I create a new record using a button on the form Dmax is used to find the highest offcut No value in a table and add one to it.
This appear to work in the form as the offcut no txtbox increments. But when i look at the table instead of having records with an increasing offcut no Instead all records read 1
Try sending your where clause in the DMax like this, assuming the WOID field in the table is an number type and not text or date.
"[WOID] = " & Forms![frmAddStockBooking]![MouldWO]
It would be better to evaluate your DMax() expression only once, especially if dbo_tblOffcuts is a large linked table without a usable index on [WOID].
If your DMax() expression can return a Null, use Nz() to transform the Null to zero. Then add one.
Dim bytoffcut As Byte
Dim strCriteria
strCriteria = "[WOID] = " & Forms![frmAddStockBooking]![MouldWO]
'Debug.Print strCriteria '
bytoffcut = Nz(DMax("OffcutNo", "dbo_tblOffcuts", _
strCriteria), 0) + 1
MsgBox bytoffcut
Me.txtOffcut.value = bytoffcut
This may not give you what you want when other users are editing dbo_tblOffcuts.
I have managed to solve the issue of multiple records being updated by creating a primary key for the table I am writing to.
I think that because Access could not uniquely identify the record it would edit all the records that met the criteria or something of the ilk. I am not entirely sure myself.
My goal: to compare the filenames in a directory with the names in a spreadsheet. If there is a match, then I wish to append the corresponding account number of that name to the filename.
I have used the dir command to retrieve all of the filenames in a directory, then pasted the list into a column in the Excel spreadsheet.
I now have 4 columns: Account number, LastName, FirstName, and filename. The main problem here is that the filenames are inconsistent. They're in the form of "lastname, firstname date", but they vary in the forms of "Smith, John 010112", "Smith, J. 010112", "Smith J 010112". This means that when it comes to the first name, I'll only be comparing the first letter of the string.
So essentially, for each filename I need to check the lastname against the lastname column. If a match is found, then I need to check the first letter of the filename's firstname against the first letter of the firstname in the same row as the matching lastname. If this is also a match, then I need to grab the account number in that row and append it to the filename.
How could I do this? I'm pretty new to Excel functions, but I do have a little experience with coding in Java and C from some college classes.
Since you already have the filenames in a column, you can solve the rest using an Excel Formula
=IF(SEARCH(B2&", "&LEFT(C2,1),D2,1)>0,A2&"-"&D2,IF(SEARCH(B2&" "&LEFT(C2,1),D2,1)>0,A2&"-"&D2,""))
This formula will hold true for both Jake Smith and John Smith.
Snapshot
Note:
A2&"-"&D2 part in the formula adds the Ac. No to the Old Filename. If you want Ac. No to be added in the end then change the above to D2&"-"&A2
Well dealling with inconsistent strings can be tricky. Here's a function that can determine the matching last name, and intial of the first name, provided the string pattern doesn't vary outside of your example. Add it to a module, then you can access it by typing in the formula =AppendFileName into a cell.
Public Function AppendFileName(ByVal LName As String, ByVal FName As String, ByVal FileName As String, ByVal AccN As String) As String
If LName = Left(FileName, Len(LName)) Then
If Mid(FileName, Len(LName) + 1, 1) = "," Then 'Check if the string contains a comma
If Mid(FileName, Len(LName) + 3, 1) = Left(FName, 1) Then
AppendFileName = FileName & " " & AccN
End If
Else 'If no comma then assume just one space
If Mid(FileName, Len(LName) + 2, 1) = Left(FName, 1) Then
AppendFileName = FileName & " " & AccN
End If
End If
End If
If AppendFileName = "" Then AppendFileName = False
End Function
You can create a loop around this code to go through all the files and names and automate with the dir function, eg.
Dim x as integer, DirFile as string
DirFile = Dir(Path)
Do While DirFile <> ""
x = x + 1 'To track how many files, and to assign variables as in below line of code
'Set each string variable like FName = Range("A1").offset(x,0).value
'Then assess the the names and file names with the If statements above
'Do something with appended FileName
DirFile = Dir
Loop
Hope this helps.