I am using a mySql server connection to get table data into excel. I have a total of three queries, two of which work perfectly and are copied correctly from copyFromRecordSet. However, the third query does not work correctly when I use copyFromRecordset. It gets two of the columns I want, but leaves off the next five. The query works correctly when I use it in a database GUI so that is not the issue.
I am trying to use an alternative to copyFromRecordSet, a piece of code which I altered from https://support.microsoft.com/en-us/help/246335/how-to-transfer-data-from-an-ado-recordset-to-excel-with-automation.
'Open and copy the recordset to an array to allow for copying into worksheet
RS.Open PriceChangeQuery
recArray = RS.GetRows
recCount = UBound(recArray, 2) + 1 '+1 since the array is zero-based
fldCount = RS.Fields.Count
' Check the array for contents that are not valid when
' copying the array to an Excel worksheet
For iCol = 0 To fldCount - 1
For iRow = 0 To recCount - 1
' Take care of Date fields
If IsDate(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = Format(recArray(iCol, iRow))
' Take care of OLE object fields or array fields
ElseIf IsArray(recArray(iCol, iRow)) Then
recArray(iCol, iRow) = "Array Field"
End If
Next iRow 'next record
Next iCol 'next field
'Transpose and copy the array to the worksheet,
'starting in cell A2
CompareFile.Sheets("VendorFilteredPriceChangeReport").Cells(2, 1).Resize(recCount, fldCount).Value = TransposeDim(recArray)
'CompareFile.Sheets("VendorFilteredPriceChangeReport").Range("A2").CopyFromRecordset RS
'Close ADO objects
RS.Close
And this is the TransposeDim function.
Function TransposeDim(v As Variant) As Variant
' Custom Function to Transpose a 0-based array (v)
Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
Dim tempArray As Variant
Xupper = UBound(v, 2)
Yupper = UBound(v, 1)
ReDim tempArray(Xupper, Yupper)
For X = 0 To Xupper
For Y = 0 To Yupper
tempArray(X, Y) = v(Y, X)
Next Y
Next X
TransposeDim = tempArray
End Function
However, when I run this piece of code the query is again leaving off the last five columns.
Any insights as to how to fix this piece of code or insights as to why copyFromRecordSet would be behaving strangely would be appreciated
In order to access some records properly, a recordSet's cursor must be set to client side. I was able to do this by using:
RS.CursorLocation = adUseClient in my code, right after opening the recordset using my query. I was then able to copy the data from the recordset using only CompareFile.Sheets("VendorFilteredPriceChangeReport").Range("A2").CopyFromRecordset RS and I got the correct data in my workbook.
Related
I have an excel document that I want to link to an SQL query. In the excel document I have a list of item numbers. Whenever an item number gets changed I want the sql query to query that list of item numbers and return an output. Basically I want the excel sheet to use the Item Number as a parameter for the database item numbers ? The excel item numbers are updated daily.
Keep in mind that this is a mock example for what you are trying to do. With no knowledge of your database or spreadsheet, I can't guarantee that any of this will even work. At the very least, it will require you to make some adjustments before you can use it.
With that in mind, I have commented on various parts of the code to let you know what is going on there. The sections that have a *** are areas that you may want to change. The sections with ### are areas that you will HAVE to change for it to work for you.
This code assumes that you have a list of item numbers in column A of sheet 1, that each item number will only return one record, and that there are no blank cells in your list of item numbers.
Sub GrabItemInfo()
Dim objADO As New ADODB.Connection
Dim objRecSet As New ADODB.Recordset
Dim objCmd As New ADODB.Command
Dim strConn As String
Dim strSQL As String
Dim RowNum As Long
Dim errNum As Long
'open a connection to the database
'### change the properties for the connection to suit your needs
strConn = "DSN=DSNName; DBQ=Database; UID=Username; PWD=Password"
objADO.Open strConn
objCmd.ActiveConnection = objADO
objCmd.CommandType = adCmdText
'errNum is the row that the error log will start on
'***change errNum to change which row it starts on
errNum = 1
'***changeRowNum here to change which row to start on
RowNum = 1
'start the loop
Do Until ThisWorkbook.Sheets(1).Cells(RowNum, 1) = ""
On Error Resume Next
'### change the sql to whatever you need
'*** change the cells section if you're not using the first column
strSQL = "SELECT [field] FROM [table] WHERE ItemNum = " & ThisWorkbook.Sheets(1).Cells(RowNum, 1).Value
objCmd.CommandText = strSQL
Set objRecSet = objCmd.Execute
'pastes results from query into the cell next to the item number
'***change the cells section if you want to use a different column
ThisWorkbook.Sheets(1).Cells(RowNum, 2).CopyFromRecordset objRecSet
'clear out the recordset before the loops starts again
Set objRecSet = Nothing
'put the item number, error number, and error description on the second sheet of the work book
'***change the sheet number to put it on another sheet if you're already using the second
If Err > 0 Then
ThisWorkbook.Sheets(2).Cells(errNum, 1).Value = ThisWorkbook.Sheets(1).Cells(RowNum, 1).Value
ThisWorkbook.Sheets(2).Cells(errNum, 2).Value = Err.Number
ThisWorkbook.Sheets(2).Cells(errNum, 3).Value = Err.Description
On Error GoTo 0
End If
'raise the value for the row for the next iteration
RowNum = RowNum + 1
Loop
'clear out the connection
Set objADO = Nothing
Set objRecSet = Nothing
Set objCmd = Nothing
End Sub
For more information on connection strings, I recommend http://www.connectionstrings.com
It's a great resource to use for figuring out what kind of connection string you need. Connections strings can be...tricky...sometimes, and this really helps.
If you need any resources for SQL, I would recommend http://www.w3schools.com/sql
They have a good introduction to it there. Past that, get a good reference book, find a mentor, join forums(or Q&A sites like this one), etc. If you look into the SQL tag on this site, there is more information, along with some recommended resources as well.
Good luck.
I'm pulling data from a MySQL db into a worksheet by saving it as a csv and pasting that csv data into a worksheet. This csv holds all the data for all clients, separated by marker cells that look like: "Client1:START" and "Client1:END". Then I'm running a macro that copies two pages: one with individual clients' data from the aggregated sheet, and another that has charts that run off that data.
I've got almost everything working: copying all the pages and updating the references from the charts and the cells that pull information from the data sheet for that client.
The only thing left to do is copy the data from the aggregated sheet to each individual client's sheet. I gave this a lot of thought, and it seems that the easiest way to do this, given that I don't know the number of rows that will be generated for a given client (anything between zero and 31, since this is a monthly report), is to have "Client1:START" in the first cell of the row preceding the first row for that client, and "Client1:END" in the first cell of the row after.
Then I can simply search through the cells until I find those two, name them (since I can't figure out how to save a cell address in a variable yet), then offset them somehow to get the actual range that I want, minus the markers.
Then I can copy that range and paste it into the newly-created data sheet.
I haven't even gotten as far as the offsetting yet, actually. I'm still floundering trying to select the cells based on their names. This is what I have:
Dim Client
Dim SelectedCell
Dim StartCell
Dim EndCell
For Each Client In Array("Client1", "Client2")
StartCell = Client & "StartCell"
EndCell = Client & "EndCell"
Sheets("ALL-DATA").Select
For Each SelectedCell In Range("A1:D20")
If SelectedCell.Value = Client & ":START" Then
SelectedCell.Name = StartCell
End If
If SelectedCell.Value = Client & ":END" Then
SelectedCell.Name = EndCell
End If
Next SelectedCell
Range(StartCell & ":" & EndCell).Select '<-- This won't compile
Next Client
That Range won't let me select using variables, so I'm a bit stuck. It appears that VBA only lets you select a range using a string of addresses.
If anybody can point me in the right direction, it would be much appreciated. And if you know how I can adjust the selection to exclude the actual markers (taking into account the possibility of the data being zero rows long) that would be fantastic and a huge bonus.
Thanks!
This code doesn't compile for a number of reasons I mentioned in comments above. I believe this below will work. You should be in the habit of always declaring your variables and using Option Explicit to prevent typos/etc.
You need a way to get the cell's Address, and that is by referencing it's .Address property :) Cells and ranges don't have a .Name property, so your code would actually fail on the line SelectedCell.Name = StartCell
Your assignment statements are backwards. IN order to assing to the StartCell variable, that variable must be on the left of the assignment statement, and if it needs to represent an object like a cell/range, then you must also use the Set keyword, i.e., Set StartCell = Range("A1").
I have also updated this to avoid any use of Select method. it's 99.9% of the time unnecessary to Select or Activate anything in Excel.
Dim Client as Variant
Dim SelectedCell as Range
Dim StartCell as Range
Dim EndCell as Range
Dim ClientRange as Range
For Each Client In Array("Client1", "Client2")
For Each SelectedCell In Sheets("ALL-DATA").Select.Range("A1:D20")
If SelectedCell.Value = Client & ":START" Then
Set StartCell = SelectedCell
ElseIf SelectedCell.Value = Client & ":END" Then
Set EndCell = SelectedCell
End If
Next SelectedCell
Set ClientRange = Sheets("ALL-DATA").Range(StartCell.Address & ":" & EndCell.Address)
Next Client
Now you've qualified ClientRange as belonging to "All-DATA" worksheet, there is generally no need to ever Select or Activate it for any reason. Doing so only adds unnecessary operations and complexity to the code and slows its performance.
If the rows contain client specific cell then use auto filter to show only those rows. Then do a Select All (record it).
To your specific question.
To find your cell I recorded (Tools - Macro - Record New Macro) Edit -Find
Cells.Find(What:="fred", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
And you can change that a bit to
Set client = Cells.Find(What:="fred", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
I handle this in the number of functions.
1) Get the references to the start and end of the table:
Use Application.Range or Me.Range To find the start and end of the table that's identified by a named range. In this case a the table has a header and a foot row to mark the beginning and end of the table.
I keep these functions inside the worksheet's module, which allows me to use Me.Range. I also use limit the scope of the named range to the worksheet only.
Private Function GetTableStart() As Long
GetTableStart = Me.Range("TABLE_START").Row + 1
End Function
Private Function GetTableEnd() As Long
GetTableEnd = Me.Range("TABLE_END").Row - 1
End Function
I also name the columns, COLUMN_ID is a named range that selects a whole column in a worksheet. e.g It's named range is 'Worksheet'!$A:$A
Private Function GetColumnId() As Long
GetColumnId = Me.Range("COLUMN_ID").Column
End Function
Private Function GetLastColumn() As Long
GetLastColumn = Me.Range("COLUMN_LAST").Column
End Function
2) Change the Table's Size. Give it the number of rows you want and it'll resize the table for you. :
Private Sub FixTableSize(expectedRows As Long)
If expectedRows = 0 Then
Err.Raise vbObjectError + 513, Me.name, "Cannot resize the table's number of rows to 0"
End If
Dim startRow As Long
Dim endRow As Long
Dim startColumn As Long
Dim endColumn As Long
Dim numberOfRows As Long
Dim table As Range
startRow = GetTableStart()
endRow = GetTableEnd()
startColumn = GetColumnId()
endColumn = GetColumnEnd()
numberOfRows = endRow - startRow + 1
Set table = Me.Range(Me.Cells(startRow, startColumn), Me.Cells(endRow, endColumn))
If numberOfRows > 0 Then
' Prevent it from clearing the headers
table.ClearContents
End If
With Me
Dim cnt As Integer
If expectedRows > numberOfRows Then
For cnt = 1 To (expectedRows - numberOfRows)
table.Rows(2).Insert xlShiftDown
Next cnt
ElseIf expectedRows < numberOfRows Then
For cnt = 1 To (numberOfRows - expectedRows)
table.Rows(1).Delete xlShiftUp
Next cnt
End If
End With
End Sub
3) Populate the table. Once the table is the right size, I populate the table with the data I want.
Private Sub PopulateIssues(sprints() As JIRASprint)
Dim currentSprint As Variant
Dim currentRow As Long
currentRow = GetTableStart()
For Each currentSprint In sprints
Me.Cells(currentRow, GetColumnId()).Value = currentSprint.Id
Me.Cells(currentRow, GetColumnName()).Value = currentSprint.name
Me.Cells(currentRow, GetColumnClosed()).Value = currentSprint.Closed
Me.Cells(currentRow, GetColumnStartDate()).Value = currentSprint.startDate
Me.Cells(currentRow, GetColumnEnd()).Value = currentSprint.endDate
If currentSprint.completeDate <> 0 Then
Me.Cells(currentRow, GetColumnCompleteDate()).Value = currentSprint.completeDate
End If
currentRow = currentRow + 1
Next
End Sub
4) Then I put it all together with one subroutine called update tables.
Private Sub UpdateTable()
On Error GoTo ErrHandler
Dim numberOfRows As Long
Dim sprints() As JIRASprint ' Where JIRASprint is a custom Class I made.
numberOfRows = ... ' Find out how many rows I need somehow.
Set sprints = GetData() ' Get the data however you want.
' turn these off so it updates faster ...
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
FixTableSize numberOfRows
PopulateIssues sprints
' turn them back on ...
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
ErrHandler:
' turn them back on ...
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "An error occured while updating the worksheet"
End Sub
Hope this helps!
I am pulling out my hair trying to parse data or edit into a msgraph series collection.
I get error 438 - object does not support this property or method.
I can manipulate other properties that the object has such as ChartTitle.Font.Size but not the seriescollection.
Intellisencing is not working wth this object which leads me to susspect that I have not set a particular reference.
Sections of the code is below.
The main routine gets the object:
strReportName = "Security Selection"
strChartName = "MACD_Chart"
DoCmd.OpenReport strReportName, acViewDesign
Set rptMACD = Reports(strReportName)
Set chartMACD = rptMACD(strChartName)
A data recordset is built then all of it is passed into the subroutine:
Call UpdateChart(chartMACD, rstMACD)
Public Sub UpdateChart(chartPlot As Object, rstChart As ADODB.Recordset)
'FUNCTION:
' a chart object is passed into the routine,
' source data is update to the recordset being passed in.
Dim lngType As Long
Dim i, j, iFieldCount As Integer
Dim rst As Recordset
Dim arXValues() As Date
Dim arValues() As Double
Dim strChartName, strYAxis, strXAxis As String
Dim ChrtCollection As ChartObjects
Dim colmCount As Integer
chartPlot.RowSourceType = "Table/Query"
'get number of columns in chart table/Query
iFieldCount = rstChart.Fields.Count
With chartPlot
'change chart data to arrays of data from recordset
.Activate
j = 0
rstChart.MoveFirst
Do While Not rstChart.EOF
j = j + 1
ReDim Preserve arXValues(1 To j)
arXValues(j) = rstChart.Fields("Date").Value
rstChart.MoveNext
Loop
For i = 1 To iFieldCount - 1 'Date is first field
j = 0
rstChart.MoveFirst
Do While Not rstChart.EOF 'get next array of data
j = j + 1
ReDim Preserve arValues(1 To j)
arValues(j) = rstChart.Fields(i + 1).Value
rstChart.MoveNext
Loop
.SeriesCollection(i).Name = rstChart.Fields(i + 1).Name
.SeriesCollection(1).XValues = arXValues
.SeriesCollection(i).Values = arValues
Next i
end sub
I've tried many things and now I'm totally confused. I've also been trying to parse in recordsets (which is my preference) but i'll take anything at the moment.
Before continuing: I recommend setting the Chart's Rowsource property to a query that returns the data you want and then Requerying the Chart. This is WAY easier than the following.
You are getting the Error 438 because Name, XValues, Values are not properties of the Series Object. MSDN Info
That being said, here is a go at your method and some recommendations for doing it that way. The SeriesCollection doesn't contain the values associated with MSGraph points like it does in Excel. You need to edit the data in the DataSheet, which is VERY finicky. A reference to the Microsoft Graph Library must be included. This was tested to work with my database. Microsoft Graph MSDN info
DAO
Public Sub testing()
Dim rstChart As Recordset
Dim seri As Object, fld As Field
Dim app As Graph.Chart
chartPlot.SetFocus
Set app = chartPlot.Object
Set rstChart = CurrentDb.OpenRecordset("SELECT DateTime, ASIMeasured FROM Surv_ASI WHERE CycleID = 2 ORDER BY DateTime")
app.Application.DataSheet.Range("00:AA1000").Clear
With rstChart
For Each fld In .Fields
app.Application.DataSheet.Range("a1:AA1").Cells(0, fld.OrdinalPosition) = fld.Name
Next
Do While Not .EOF
For Each fld In .Fields
app.Application.DataSheet.Range("a2:AA1000").Cells(.AbsolutePosition, fld.OrdinalPosition).Value = fld
Next
.MoveNext
Loop
End With
app.Refresh
End Sub
ADO (Assuming rstChart is already a valid ADODB.Recordset)
Public Sub testing()
Dim app As Graph.Chart, i As Integer
chartPlot.SetFocus
Set app = chartPlot.Object
app.Application.DataSheet.Range("00:AA1000").Clear
With rstChart
.MoveFirst 'Since I don't know where it was left off before this procedure.
For i = 0 To .Fields.Count - 1
app.Application.DataSheet.Range("a1:AA1").Cells(0, i) = .Fields(i).Name
Next
Do While Not .EOF
For i = 0 To .Fields.Count - 1
app.Application.DataSheet.Range("a2:AA1000").Cells(.AbsolutePosition, i).Value = .Fields(i)
Next
.MoveNext
Loop
End With
app.Refresh
End Sub
Some notes about my changes:
1. I prefer having my With point to the Recordset being cycled, instead of the Object being operated on, especially since more calls are made to the Recordset's properties in your procedure.
2. You don't need to specify the variable to which a Next applies (Next i). Just put Next.
3. Please pick my answer if it helped :)
I have a form with a subform. This subform displays the results of a query that is created dynamically (user enters criteria, I build the SQL, then update the querydef and display). Problem is since the columns are dynamic the width of the columns isn't working out, some are cutting off text.
Is there a way to programmatically loop through the columns (or do the same without loop) and set them all to bestfit width after the query is refreshed?
EDIT: Here is what my code looks like now:
CurrentDb.QueryDefs("SearchResults").sql = sql
CurrentDb.QueryDefs.Refresh
Dim qdf1 As DAO.QueryDef
Dim fld1 As DAO.Field
Set qdf1 = CurrentDb.QueryDefs("SearchResults")
For i = 0 To qdf1.Fields.Count - 1
Set fld1 = qdf1.Fields(i)
fld1.CreateProperty "ColumnWidth", dbInteger
fld1.Properties("ColumnWidth") = -2 'Throws error
Set fld1 = Nothing
Next i
Me.Child20.SourceObject = "Query.SearchResults"
You can set column widths like so:
Sub SetColumnWidth()
Dim qdf1 As DAO.QueryDef
Dim fld1 As DAO.Field
Set qdf1 = CurrentDb.QueryDefs("query3")
For i = 0 To qdf1.Fields.Count - 1
Set fld1 = qdf1.Fields(i)
fld1.CreateProperty "ColumnWidth", dbInteger
'very narrow indeed
'fld1.Properties("ColumnWidth") = 200
'Or -2 : Sizes the column to fit the visible text
'but it is not quite as useful as it would seem
fld1.Properties("ColumnWidth") = -2
Set fld1 = Nothing
Next i
End Sub
See also http://support.microsoft.com/kb/210427
So I've run into this same problem just now. I was fortunate enough to have half of my queries work and the other half not. I've been using this code:
Sub QueryData(strSQL As String)
Dim qryData As DAO.QueryDef
Dim intcount As Integer
Set qryData = CurrentDb.QueryDefs("DataQuery")
qryData.SQL = strSQL
qryData.CreateProperty "ColumnWidth", dbInteger
qryData.Fields(0).Properties("ColumnWidth") = 5760
DoCmd.OpenQuery "DataQuery", , acReadOnly
End Sub
Which generated the error on half of the queries I tried to run with it. I traced it back to this odd, but simple truth: Columns built using an Alias (i.e. all formula columns and expressions) kick out this error. If the column is just a straight data pull, it works fine. If the column is, however, a formulated display.... it spits the no columwidth property error.
Hopefully this'll help someone out! I know this questions about a year old, but it was the first result Google found for me on the topic.
I was able to make this grab the open forms and autofit the selected subform within that form. If you have multiple forms/subforms you would just call the function with the new names using the lines of code at the end of the function and pasting them in your program.
Public Function AutoSizeSbCtrl(frmNameTar, sbCtrlNameTar)
For Each frm In Forms
frmName = frm.Name
If frmName = frmNameTar Then
For Each frmCtrl In frm.Controls
frmCtrlName = frmCtrl.Name
If frmCtrlName = sbCtrlNameTar Then
For Each sbfrmCtrl In frmCtrl.Controls
sbfrmCtrlName = sbfrmCtrl.Name
On Error Resume Next
sbfrmCtrl.ColumnWidth = -2
On Error GoTo 0
Next sbfrmCtrl
End If
Next frmCtrl
End If
Next frm
' paste the lines below in your code where you want it to trigger (i did on an update)
'frmNameTar= "frm12345" ' where frm12345 is the name of the form the subform is in
'sbCtrlNameTar="sbfrm67890" ' where sbfrm67890 is the name of the subform you are trying to autofit
'auSize = AutoSizeSbCtrl(frmNameTar, sbCtrlNameTar)
'end paste
End Function
I inherited an MS Access database at my office that is heavily used by several people over the network. This causes many issues with data collisions and locks. I want to split the db so that each user has thier own front-end app and maintain the core data on the server.
Several of the tables use an autonumber:sequence:long as thier primary key - in researching how to perform the split I've come across several posts that hint this can cause issues when distributing a database but I haven't been able to find anything solid. The issue seems to be that a user can begin a new record and receive the next autonumber but a second user can create a new record within a short interval and receive the same autonumber resulting in an error?
Does Jet handle this correctly or are there autonumber issues with a FE/BE database? If it's an unlikely-but-possile occurance I'm sure it will still be much better than what my users are currently experiencing but I'd like to know if there are ways I can minimize such issues.
Thanks for your help!
I've had the misfortune of working with many Access databases in my youth. While there are many issues with Access, I do not know if I've ever run into a problem with AutoNumber columns in a split database, multi-user environment. It should work fine. This is such a common setup that there would be posts all over the Internet about it if were an issue.
As long as you are not going for data replication (ie multiple subscriber databases, where users can insert new records in same tables but in different locations), you will not have problems with autonumbers as primary keys.
If you think that one of these days you might need to go for replication (different locations, one central database), do not hesitate to switch to unique identifiers (replication IDs).
There seems to be some confusion on your part about the process of splitting. When you do so, you end up with multiple front ends, but the back end is still a single file. Thus, there's no difference at all for the data tables in terms of Autonumbers from what you had before you split the application.
I had the same problem, nevertheless i did a workarround to get the autonumbering work from an Onload() Event
What I did is :
I create a recordset based on Your_Table everytime the user needs an autonumber
Open the recordset (rst)
Search if:
-Your_Table is Empty, then assigns the value "1" to Your_field
-Your_Table is has data without missing numbers,then assigns the value = "Count of lines + 1" to Your_field (1,2,....,n+1)
-Your_Table has missing data (1,3,4,5,7) [Note "#2 and #7 are missing]", then uses a function to search in Your_Table the missing fields and assign to Your_Field the first missing value (#2 in this example)
Private Sub Autonumbering(Your_Table As String)
Dim rst As DAO.Recordset
Dim db As Database
On Error GoTo ErrorHandler
Application.Echo False
Set db = CurrentDb
Set rst = db.OpenRecordset(Your_Table, dbOpenDynaset)
With rst
.AddNew
'Your_Table is Empty, **then** assigns the value "1" to Your_field
If DMin("[Your_Field]", Your_Table) = 1 Then
'Your_Table is has data without missing numbers,**then** assigns the value = "Count of lines + 1" to Your_field (1,2,....,n+1)
If DMax("[Your_Field]", Your_Table) = .RecordCount Then
'Assings n+1 value to [Your_Field] records
Value = .RecordCount + 1
![Your_Field] = Valor
Else
'Your_Table has missing data (1,3,4,5,7) [Note "#2 and #7 are missing]", **then** uses a function to search in Your_Table & _
the missing fields and assign to Your_Field the first missing value (#2 in this example)
Value = MyFunction$(Your_Table, "Your_Field")
![Your_Field] = Value
End If
Else
'Agrega el número 1
Value = 1
![Your_Field] = Value
End If
.Update
.Bookmark = .LastModified
Me.Requery
DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, Value
.Move 0, .LastModified
End With
ErrorCorregido:
Application.Echo True
Exit Sub
ErrorHandler:
MsgBox "An error ocurred, please verify numbering", vbCritical + vbOKOnly
Resume ErrorCorregido
End Sub
Here is the function that i found to get the missing values on an specific table, i cant find it anymore, but thanks for the one who made it.
Function MyFunction$(cstrTable As String, cstrField As String)
' Read table/query sequentially to record all missing IDs.
' Fill a ListBox to display to found IDs.
' A reference to Microsoft DAO must be present.
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim lst As ListBox
Dim Col As Collection
Dim strSQL As String
Dim strList As String
Dim lngLast As Long
Dim lngNext As Long
Dim lngMiss As Long
' Build SQL string which sorts the ID field.
strSQL = "Select " & cstrField & "" _
& " From " & cstrTable & " Order By 1;"
Set Col = Nothing
' Control to fill with missing numbers.
'Set lst = Me!lstMissing
' Collection to hold the missing IDs.
Set Col = New Collection
'// Vacía la colección
'Erase Col
' Read the table.
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSQL)
If rst.RecordCount = 0 Then
' The recordset is empty.
' Nothing to do.
Else
' Read and save the ID of the first record.
lngLast = rst(cstrField).value
rst.MoveNext
' Loop from the second record through the recordset
' while reading each ID.
While rst.EOF = False
lngNext = rst(cstrField).value
' For each ID, fill the collection with the
' missing IDs between the last ID and this ID.
For lngMiss = lngLast + 1 To lngNext - 1
Col.Add (lngMiss)
Next
' Save the last read ID and move on.
lngLast = lngNext
rst.MoveNext
Wend
' Finally, add the next possible ID to use.
Col.Add (lngLast + 1)
End If
rst.Close
For lngMiss = 1 To Col.Count
' Build the value list for the ListBox.
If Len(strList) > 0 Then
' Append separator.
strList = strList & ";"
End If
' Append next item from the collection.
strList = strList & Col(lngMiss)
' For debugging only. May be removed.
Debug.Print Col(lngMiss)
Next
' Pass the value list to the ListBox.
' Doing so will requery it too.
' lst.RowSource = strList
' For debugging only. May be removed.
' Debug.Print strList
MyFunction$ = Col(1)
' Clean up.
Set rst = Nothing
Set dbs = Nothing
Set Col = Nothing
Set lst = Nothing
End Function