I am trying to add some data into 'List' form(exactly copy).
Below is my code.
Option Compare Database
Private Sub addToListSample_Click()
Dim introw As Integer
introw = ListSample.ListIndex + 1
ListSample.Column(0, introw) = TextP11.Value
ListSample.Column(1, introw) = TextP12.Value
ListSample.Column(2, introw) = TextP13.Value
ListSample.Column(3, introw) = TextP14.Value
ListSample.Column(4, introw) = TextP15.Value
ListSample.Column(5, introw) = TextP16.Value
ListSample.Column(6, introw) = TextP17.Value
End Sub
But when I execute it, I get following error.
"Run-time error '424' : Object required"
Why do I get this error? I think this is pretty easy code, but I don't know why this error keep annoying me....
Start by changing
introw = ListSample.ListIndex + 1
to
introw = Me.ListSample.ListIndex + 1
At some point you will probably also have to check that the listbox is actually selected or you will always get 0.
edit:
'add a row with hard-coded values:
'Dim introw As Integer
'introw = Me.lstEmpty.ListIndex + 1 '<-- not really needed when using AddItem.
'Me.lstEmpty.AddItem "value 1;value 2"
'or add a row using values from textboxes:
Me.ListSample.AddItem TextP11.Value & ";" & TextP12.Value & ";" & TextP13.Value
This will add values to one row, in different columns.
Your list box's Row Source Type will have to be set to Value List.
The Column Count will have to match the number of columns you're adding.
Related
I am trying to track down where I may be throwing a pointer (Lost/misdirected) while trying to concatenate several different tables. Keep in mind that the section of code below is only a small part of 16,000 lines of code but stands completely alone.
Two sections of code are below.
How the code should work:
Basically what the code should do is as follows... When I press a button (First Section of code), several table names are passed to a sub one at a time (Second section of code).
More clearly, A table name is passed (First section), then the sub runs with that table name (Second section) and places in into a table called "CymeImportTable", then table two is passed (First section) then the sub runs again (Second section) and appends table two in "CymeImportTable". I know I can put these into an array but maybe later on. I'm just trying to get everything to work first then optimize. Okay so the above works fine... sometimes.
The results:
The code runs and places each table record into one MEMO style cell. For the below code and my table sizes, I have about 4000 records with several fields in my tables that get placed into a CymeImportFile table of 4000 records of only one field. This works great sometimes and seemed to work at the beginning all the time, maybe before my tables began to get larger??
Issue:
The issue is this... The CymeImportFile table will sometimes get populated but other times will get populated with what seems to be nothing. The same number of records appear in both instances but sometimes has text (What I want), and other times does not have anything (Not what I want). Just blank records with a blank field.
What I know:
I know MEMO is not recommended, may be my issue, but I will have to largely modify my code to avoid the memo format and it suits my needs as a memo.
My tables always of contents in them and this issue is not a result of my program pulling in nothing.
This issue occurs is several other sections of my code (not shown) but this was the simplest/shortest portion. I cant post the other sections because all in all its about 16,000 lines of code.
I know we may not be able to locate the error with only the code I provided but I would like to see what you guys think to see if there is something obvious that I don't know about. I have only been programming VBA for about a month.
First section of code below:
I do not believe the issue lies here but I wanted to give as much information as possible. This section below just passes the table name to the sub called "Concatenate" when a button is pressed. Keep in mind, this code is probably not optimized.
Private Sub buttonConcatenate_Click()
DoCmd.SetWarnings False
DoCmd.CopyObject , "CymeImportFile", acTable, "Template_CymeImportFile"
'DoCmd.RunSQL "DELETE * FROM CymeImportFile"
DoCmd.SetWarnings True
Dim Table As String
'[GENERAL]
Table = "GENERAL"
Concatenate.Concatenate Table
Form_Cyme_Model_Update.CheckGeneral.Value = 0
'[IMPERIAL]
Table = "IMPERIAL"
Concatenate.Concatenate Table
' [HEADNODES]
Table = "HEADNODES"
Concatenate.Concatenate Table
Form_Cyme_Model_Update.CheckHeadnodes.Value = 0
' [SOURCE]
Table = "SOURCE"
Concatenate.Concatenate Table
Form_Cyme_Model_Update.CheckSource.Value = 0
' [NODE]
Table = "NODE"
Concatenate.Concatenate Table
Form_Cyme_Model_Update.CheckNode.Value = 0
' [LINE_CONFIGURATION]
Table = "LINE_CONFIGURATION"
Concatenate.Concatenate Table
Form_Cyme_Model_Update.CheckLine_Configuration.Value = 0
' [SECTION]
Table = "SECTION"
Concatenate.Concatenate Table
Form_Cyme_Model_Update.CheckSection.Value = 0
' [SWITCH SETTING]
Table = "SWITCH_SETTING"
Concatenate.Concatenate Table
Form_Cyme_Model_Update.CheckSwitchSetting.Value = 0
' [FUSE SETTING]
Table = "FUSE_SETTING"
Concatenate.Concatenate Table
Form_Cyme_Model_Update.CheckFuseSetting.Value = 0
' [RECLOSER SETTING]
Table = "RECLOSER_SETTING"
Concatenate.Concatenate Table
Form_Cyme_Model_Update.CheckRecloserSetting.Value = 0
' [TRANSFORMER SETTING]
Table = "TRANSFORMER_SETTING"
'Concatenate.Concatenate Table
Form_Cyme_Model_Update.CheckTransformerSetting.Value = 0
' [SECTIONALIZER SETTING]
Table = "SECTIONALIZER_SETTING"
Concatenate.Concatenate Table
Form_Cyme_Model_Update.CheckSectionalizerSetting.Value = 0
' [REGULATOR SETTING]
Table = "REGULATOR_BYPHASE_SETTING"
Concatenate.Concatenate Table
Form_Cyme_Model_Update.CheckRegulatorSetting.Value = 0
' [SHUNT CAPACITOR SETTING]
Table = "SHUNT_CAPACITOR_SETTING"
Concatenate.Concatenate Table
Form_Cyme_Model_Update.CheckShuntCapacitorSetting.Value = 0
' [INTERMEDIATE NODES]
Table = "INTERMEDIATE_NODES"
Concatenate.Concatenate Table
Form_Cyme_Model_Update.CheckIntermediateNodes.Value = 0
' [RELAY SETTING]
'Table = "RELAY_SETTING"
'Concatenate.Concatenate Table
'Form_Cyme_Model_Update.CheckRelaySetting.Value = 0
Form_Cyme_Model_Update.CheckConcatenate.Value = -1
''Message Box
MsgBox "Cyme imput has been concatenated into CymeImportFile"
End Sub
This next section is where the variable (Table name) is passed and used to place the passed table name's contents into the table "CymeInputFile".
Option Compare Database
Sub Concatenate(Table As String)
' Set the database
Set dbsCyme_Model_Update = CurrentDb
Dim Field As String
'Count records and fields
RecordCount = CurrentDb.TableDefs(Table).RecordCount
fieldCount = CurrentDb.TableDefs(Table).Fields.Count
RecordCounter = 0
ReDim fieldArray(0) As String
ReDim recordArray(0) As String
ReDim fieldArray(fieldCount - 1) As String
ReDim recordArray(RecordCount - 1) As String
Set rst = dbsCyme_Model_Update.OpenRecordset(Table)
rst.MoveFirst
Do Until rst.EOF
'Field data
fieldCounter = 0
While fieldCounter < fieldCount - 1
'Set Recordset
fieldCounter = fieldCounter + 1
Field = "Field" & fieldCounter
'rstGENERAL
fieldString = rst.Fields(Field)
fieldArray(fieldCounter - 1) = fieldString
Wend
printCounter = 0
For Each element In fieldArray
If Not fieldArray(printCounter) = "N/A" Then
holder = recordArray(RecordCounter)
If fieldArray(printCounter + 1) = "N/A" Then
recordArray(RecordCounter) = holder + fieldArray(printCounter)
Else
recordArray(RecordCounter) = holder + fieldArray(printCounter) + ","
End If
printCounter = printCounter + 1
End If
Next element
RecordCounter = RecordCounter + 1
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
Dim temp As String
'Print to the CymeImportFile
Set rst = dbsCyme_Model_Update.OpenRecordset("CymeImportFile")
'rst.MoveFirst
RecordCounter = 0
If rst.BOF Then
rst.AddNew
rst.Update
rst.MovePrevious
Else
rst.MoveLast
rst.MoveNext
rst.AddNew
rst.Update
rst.MovePrevious
End If
For Each element In recordArray
rst.Edit
temp = recordArray(RecordCounter)
rst!Field1 = temp
rst.Update
rst.MoveNext
If rst.EOF Then
rst.AddNew
rst.Update
rst.MovePrevious
End If
RecordCounter = RecordCounter + 1
Next element
rst.Close
Set rst = Nothing
End Sub
I figured it out. All those differant adds and updates confused everything. I simplified it down to this... Not quite what martin Parkin was saying but your comment lead me to play around with my printing process in this section and all the other sections that were creating my tables.
New code...
'Print to the CymeImportFile
Dim bob As String
bob = 0
Set rst = dbsCyme_Model_Update.OpenRecordset("CymeImportFile")
RecordCounter = 0
rst.MoveLast
rst.AddNew
For Each element In recordArray
'rst.Edit
rst.AddNew
temp = recordArray(RecordCounter)
rst!Field1 = temp
rst.Update
RecordCounter = RecordCounter + 1
Next element
rst.Close
Set rst = Nothing
ReDim fieldArray(0) As String
ReDim recordArray(0) As String
Debug.Print Table
End Sub
I am sure this is fairly simple put I am having trouble getting started on this. I use a Form to invoice clients which includes the field [Billing_Month]. What I'm looking to accomplish is this. When I create a new invoice, the [Billing_Month] will look to the last invoice created (use [Invoice_#] with DMax?), and populate the value from that that invoices [Billing_Month]
I have thought to use: Billing_Month = DMax ("Billing_Month", "frmInvoices"), but this doesn't specifically get me the last invoice, it would just look for the highest Billing_Month, which is a text field.
I have thought to use: Billing_Month = DLookup ("Billing_Month", "frmInvoices"), But this doesn't get me the last invoice to pull from.
I'd use a custom function for this - assuming the underlying table is called tblInvoices:
Function GetBillingMonthOfLatestInvoice()
Const SQL = "SELECT TOP 1 Billing_Month FROM tblInvoices ORDER BY [Invoice_#] DESC"
Dim RS AS DAO.Recordset
Set RS = CurrentDb.OpenRecordset(SQL)
If RS.EOF Then
GetBillingMonthOfLatestInvoice = Null
Else
GetBillingMonthOfLatestInvoice = RS(0)
End If
End Function
Update
The above code can be generalised to return other related fields like so:
Function GetValueForLatestInvoice(FieldToLookUp As String)
Dim RS As DAO.Recordset, SQL As String
SQL = "SELECT TOP 1 " + FieldToLookUp + " FROM tblInvoices ORDER BY [Invoice_#] DESC"
Set RS = CurrentDb.OpenRecordset(SQL)
If RS.EOF Then
GetValueForLatestInvoice = Null
Else
GetValueForLatestInvoice = RS(0)
End If
End Function
To use, copy the code to a new standard module, then for each relevant text box on the form, set its Default Value property in the Properties window to something like this:
=GetValueForLatestInvoice("Billing_Month")
That would be for the text box holding the billing month value; for the one holding the billing year, you would use
=GetValueForLatestInvoice("Billing_Year")
You can use a combination of both DLookup() and DMax() like so:
DLookup("Billing_Month","tblInvoices","[Invoice_#]=" & DMax("[Invoice_#]","tblInvoices"))
This problem is in an Excel .xls file.
Simplest Use Case:
Column A has one row.
Column B has 5 rows.
The 5 rows in Column B need to be merged into one row, delimited by newlines.
I have a huge .xls document where there are a ton of IDs in column A.
There are on average anywhere from 3 to 10 rows that belong to each column A row.
How to know which Column B rows belong to which Column A?
By the positioning of the cells.
One Column A row may have 5 Column B rows to the right of it.
I don't have any VBA experience.
I have looked around for macros and functions but haven't had any luck finding anything that matches this problem.
Edit:
I am now trying to figure out how to get the script to ignore rows that have a one-to-one mapping between column A and column B.
Edit again - 06-20-2012:
Now that I can attach images, here is a screenshot of an image for what I'm trying to get.
The rows for Brian and Mark should be ignored, while Scott and Tim get their values copied over.
Edit:
Unmerging column A, using the code that Andy supplied, and then using this VB script afterwards does the trick:
Sub mergeA()
For i = 2 To Cells(65535, 1).End(xlUp).Row
If IsEmpty(Cells(i, 1)) Then Range(Cells(i - 1, 1), Cells(i, 1)).Merge
Next
End Sub
That VB script puts the cells in column A back together
I didn't make the script, it came from this web page:
http://www.vbforums.com/showthread.php?t=601304
This will transform the data shown on the left to the output on the right:
Option Explicit
Sub Make_Severely_Denormalized()
Const HEADER_ROWS As Long = 1
Const OUTPUT_TO_COLUMN As Long = 3
Const DELIMITER As String = vbNewLine
Dim A_Range As Range
Dim B_Range As Range
Dim A_temp As Range
Dim B_temp As Range
Dim B_Cell As Range
Dim Concat As String
On Error GoTo Whoops
Set A_Range = Range("A1").Offset(HEADER_ROWS)
Do While Not A_Range Is Nothing
Set B_Range = A_Range.Offset(0, 1)
' some helper ranges
If A_Range.Offset(1, 0).Value = "" Then
Set A_temp = Range(A_Range, A_Range.End(xlDown).Offset(-1, 0))
Else
Set A_temp = A_Range.Offset(1, 0)
End If
Set B_temp = Range(B_Range, B_Range.End(xlDown)).Offset(0, -1)
' determine how high "B" is WRT no change in "A"
Set B_Range = Range(B_Range, B_Range.Resize( _
Application.Intersect(A_temp, B_temp, ActiveSheet.UsedRange).Count))
' loop through "B" and build up the string
Concat = ""
For Each B_Cell In B_Range
Concat = Concat & B_Cell.Value & DELIMITER
Next
Concat = Left(Concat, Len(Concat) - Len(DELIMITER))
' do the needful
A_Range.Offset(0, OUTPUT_TO_COLUMN - 1).Value = Concat
' find the next change in "A"
If A_Range.Offset(1, 0).Value = "" Then
Set A_Range = Application.Intersect(A_Range.End(xlDown), ActiveSheet.UsedRange)
Else
Set A_Range = A_Range.Offset(1, 0)
End If
Loop
Exit Sub
Whoops:
MsgBox (Err & " " & Error)
Stop
Resume Next
End Sub
I am trying to iterate through a record-set twice. Once to write all of the non-zero results, followed by a second run through to write all the rows that have a zero in a particular column so that all of those rows with the value of 0 are at the end of the file. However since .EOF has been triggered with the first run through it is still "True" when I try to run through it again. What is the best way to run through it twice?
With CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
Do Until .EOF
If .Fields(2) = 0 Then
Else
strCSV = ""
For x = 0 To .Fields.Count - 1
'No Qualifier
strCSV = strCSV & strDelimiter & Nz(.Fields(x), vbNullString)
Next x
'Eliminate Back to back strQualifiers or Qualifiers if changed
strCSV = Replace(strCSV, strQualifier & strQualifier, "")
strPrint = Mid(strCSV, Len(strDelimiter) + 1)
Print #intOpenFile, strPrint
End If
.MoveNext
Loop
Do Until .EOF
If Nz(.Fields(2), vbNullString) = 0 Then
strCSV = ""
For x = 0 To .Fields.Count - 1
'No Qualifier
strCSV = strCSV & strDelimiter & Nz(.Fields(x), vbNullString)
Next x
'Eliminate Back to back strQualifiers or Qualifiers if changed
strCSV = Replace(strCSV, strQualifier & strQualifier, "")
strPrint = Mid(strCSV, Len(strDelimiter) + 1)
Print #intOpenFile, strPrint
End If
.MoveNext
Loop
End With
To answer your question, just used .MoveFirst in between your two runs. But #Remou makes a good point that your can avoid this complication just by adding an ORDER BY into your SQL (+1)
Very old question but appears to have been active recently, and it's still coming up in searches, which is how I ended up here. And, as a new member, I need to start somewhere, so be kind.
The OP appears to be trying to code round a particular requirement, which is to have all the results in ascending numeric order, but with the zero items at the bottom. You can do this in SQL in one statement like this:
SELECT * FROM MyTable
ORDER BY MyNumField DESC, MyOtherSortField
WHERE MyNumField > 0
UNION ALL
SELECT * FROM MyTable
ORDER BY MyOtherSortField
WHERE MyNumField = 0
A UNION merges the results of two or more SELECT statements, removing duplicates. UNION ALL concatenates the results, and is more efficient, as it stops SQL removing duplicates between the two lists - in this case, we know they won't overlap due to the selection criteria being mutually exclusive.
You seem to be missing the point of a relational database, which is that it has no order other than the one you impose:
sSQL = "SELECT * FROM MyTable ORDER BY MyNumField DESC"
Set QDF = CurrentDB.CreateQueryDef ("DatOut", sSQL)
DoCmd.TransferText acExportDelim,,"DatOut","C:\Docs\Datout.csv"
I have a form that displays information on a project that has 10 check boxes. The check boxes are named "chkAudience1", "chkAudience2", etc through "chkAudience10". Any combination of boxes can be checked from none to all and anything in between.
Then I have a table that links the check boxes to the project. This table contains a field called ProjectID and a field called AudienceID (both fields are defined as number). This allows me to select all audience records for a project.
The problem is that I want to loop through the records for a project and check the boxes that match a record in the table. My current code looks like:
sqlStmt = "SELECT * FROM ProjectAudience WHERE ProjectID = " & Me.ProjectID.Value
Set rs = cn.Execute(sqlStmt)
While Not rs.EOF
'Me.chkAudience1.Value = -1
x = "Me.chkAudience" & rs(1).Value
x.Value = -1
rs.MoveNext
Wend
x will be set to "Me.checkAudience1", but the next line produces an "object required" error. How do I create a field name based on recordset data and then use that field name to set a value. (This is being done is Microsoft Access 2003)
The correct while loop is:
While Not rs.EOF
'Me.chkAudience1.Value = -1
Me.Controls("chkAudience" & (rs(1).Value)).Value = -1
rs.MoveNext
Wend
The key is the Me.Controls().