I am trying to use this code to pick comma seperated numbers from ExcUID text box of form and then feed them into tblExcIndivList table.
However what I am trying to do it to split ex: 123,1213 into lines and put them in seperate rows of UID column of tblExcIndivList table but it gets saved as 1231213 in the same cell.
Sub Upd_UID()
Dim var As Variant
Dim i As Long
var = Split(Forms.Agen_Report.ExcUID.Value, vbNewLine)
CurrentDb.Execute "DELETE * FROM tblExcIndivList;", dbFailOnError
For i = 0 To UBound(var)
CurrentDb.Execute Replace("INSERT INTO tblExcIndivList ( UID ) VALUES ( '#V' );", "#V", var(i)), dbFailOnError
Next i
End Sub
Please help.
You are not splitting correctly your string, you say it is comma-separated (i.e. 123,1213) and try to split it with vbNewLine. You should specify the comma as separator:
var = Split(Forms.Agen_Report.ExcUID.Value, ",")
This will get you past this error and split correctly the input. However I cant make sure whether your query is well-formed.
I think you need something like this.
Option Explicit
Dim aCell As Range
Private Sub UserForm_Initialize()
'~~> Change Sheet1 to the relevant sheet name
'~~> Change A1:E1 to the relevant range
For Each aCell In ThisWorkbook.Sheets("Sheet1").Range("A1:E1")
If InStr(1, aCell.Value, ",") Then _
ComboBox1.AddItem Split(aCell.Value, ",")(0)
Next aCell
'~~> Remove duplicates
RemoveDuplicates ComboBox1
End Sub
Private Sub ComboBox1_Click()
Dim tmpStr As String
ComboBox2.Clear
For Each aCell In ThisWorkbook.Sheets("Sheet1").Range("A1:E1")
If InStr(1, aCell.Value, ",") Then _
tmpStr = Split(aCell.Value, ",")(0)
If Trim(ComboBox1.Value) = Trim(tmpStr) Then _
ComboBox2.AddItem aCell.Value
Next aCell
End Sub
'~~> Procedure to remove duplicates
Private Sub RemoveDuplicates(cmb As ComboBox)
Dim a As Integer, b As Integer, c As Integer
a = cmb.ListCount - 1
Do While a >= 0
For b = a - 1 To 0 Step -1
If cmb.List(b) = cmb.List(a) Then
cmb.RemoveItem b
a = a - 1
End If
Next b
a = a - 1
Loop
End Sub
Related
I have Access data I'm trying to export to a Word table. The table has 3 columns, the first row and first column are all headers.
I'm trying to loop through the recordset and populate columns 2 & 3 with data. I'm able to start at row 2 and populate columns 2 and 3, but I cannot figure out how to move to the next row.
iTbl = 1
irow = 2
iCol = 1
Do Until recSet2.EOF
If irow > wDoc.Tables(iTbl).Rows.Count Then
wDoc.Tables(iTbl).Rows.Add
End If
For Each fld In recSet2.Fields
On Error Resume Next
iCol = iCol + 1
wDoc.Tables(iTbl).Cell(irow, iCol).Range.Text = Nz(fld.Value)
Next fld
recSet2.MoveNext
irow = irow + 1
iCol = 1
Loop
The best way to create a table in Word, especially one with a lot of data, is to first write the data into a character-delimited string format. Assign the string to a Range in Word, then use the ConvertToTable method to turn it into a table. That will save a lot of trouble with manipulating the object model and is the most efficient approach (fastest in execution).
The following code demonstrates this principle. The procedure Test creates a new instance of Word, creates a new document in the Word application then assigns the character-delimited string to the document content. This is then turned into a table. If you need to format that table, use the tbl object to do so. The way this code is written requires a reference to the Word object library (early binding). Note that it's also possible to use late-binding - you'll find loads of examples for that.
The second procedure, concatData is called in Test to create the character delimited string. It uses a Tab character as the field separator and a carriage return as the record separator. Word will accept pretty much anything as the field separator; the record separator must be a carriage return (ANSI 13).
Sub Test()
Dim wd As Word.Application
Dim doc As Word.Document
Dim rng As Word.Range
Dim tbl As Word.Table
Set wd = New Word.Application
wd.Visible = True
Set doc = wd.Documents.Add
Set rng = doc.Content
rng.Text = concatData()
Set tbl = rng.ConvertToTable
End Sub
Public Function concatData() As String
Dim retVal As String
Dim rsHeader As Long, rsCounter As Long
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("nameOfRecordset", dbOpenDynaset)
'Get headers
For rsHeader = 0 To rs.Fields.Count - 1
retVal = retVal & rs.Fields(rsHeader).Name & vbTab
Next
'Replace last TAb with a carriage return
retVal = Left(retVal, Len(retVal) - 1) & vbCr
Do While Not rs.EOF
'Get all records
For rsCounter = 0 To rs.Fields.Count - 1
retVal = retVal & rs.Fields(rsCounter).Value & vbTab
Next
retVal = Left(retVal, Len(retVal) - 1) & vbCr
rs.MoveNext
Loop
concatData = retVal
End Function
Thanks for all the help guys. I managed to figure it out and works very well. It wouldn't move down to the next row and was attempting to write data to column(4) which doesn't exist, then throwing an error. Here is the code I used:
iTbl = 1
iRow = 2
iCol = 1
For Each fld In recSet2.Fields
iCol = iCol + 1
If iCol < 4 Then
wDoc.Tables(iTbl).Cell(iRow, iCol).Range.Text = Nz(fld.value)
Else
If iCol > 3 Then
iCol = iCol - 2
iRow = iRow + 1
wDoc.Tables(iTbl).Cell(iRow, iCol).Range.Text = Nz(fld.value)
End If
End If
Next fld
I am trying to delete duplicate records in MS ACCESS.
I have created a query that is sorted on field name.
I have VBA code that runs through the query, and then when finds a match it deletes the record - however it is not picking up the match.
My code looks as follows:
Dim db As DAO.Database
Dim recIn As DAO.Recordset
Dim strFieldName1 As Variant
Dim strFieldDescr2 As Variant
Dim strDomainCat3 As Variant
Dim strBusinessTerm4 As Variant
Dim strtableName5 As Variant
Dim lngRecordsDeleted As Variant
lngRecordsDeleted = 0
Set db = CurrentDb()
Set recIn = db.OpenRecordset("qryMyRecords")
If recIn.EOF Then
MsgBox ("No Input Records")
recIn.Close
Set recIn = Nothing
Set db = Nothing
Exit Sub
End If
Do
If recIn!FieldName = strFieldName1 And _
recIn!FieldDescr = strFieldDescr2 And _
recIn!DomainCatID = strDomainCat3 And _
recIn!BusinessTermID = strBusinessTerm4 And _
recIn!TableID = strtableName5 Then
recIn.Delete
lngRecordsDeleted = lngRecordsDeleted + 1
Else
strFieldName1 = recIn!FieldName
strFieldDescr2 = recIn!FieldDescr
strDomainCat3 = recIn!DomainCatID
strBusinessTerm4 = recIn!BusinessTermID
strtableName5 = recIn!TableID
End If
recIn.MoveNext
Loop Until recIn.EOF
recIn.Close
Set recIn = Nothing
Set db = Nothing
MsgBox ("You Deleted " & lngRecordsDeleted & " Records")
End Sub
My StrFieldname1, through to to StrTablename5 does populate (after the else statement)
However when I do the compare a second time
If recIn!FieldName = strFieldName1 And _
recIn!FieldDescr = strFieldDescr2 And _
recIn!DomainCatID = strDomainCat3 And _
recIn!BusinessTermID = strBusinessTerm4 And _
recIn!TableID = strtableName5 Then
recIn.Delete
lngRecordsDeleted = lngRecordsDeleted + 1
Even though the values are the same, it moves to the else statement, and never does the record delete.
Now I suspect that this could be because I declared my variables as VARIANT type, but if I use any other type, the code falls over every time it reaches a NULL value in the query, and there are cases where any of the fields from the query can and will be null.
Any suggestions would be greatly appreciated
To expand on what Justin said, use the Nz function in your main If statement, like so:
If Nz(recIn!FieldName, "") = strFieldName1 And _
...
Else
strFieldName1 = Nz(recIn!FieldName, "")
...
I have the following vba code in an access 2007 file:
Private Sub Form_Load()
Dim a As String
Dim b As DAO.Recordset
a = " select col1 from table1 where id = 1 "
Set b = CurrentDb.OpenRecordset(a)
MsgBox (b)
b.Close
End Sub
But I am getting the following error on the MsgBox (b) line. Any idea why that's happening? The query returns a single value, which I want to display in a message box.
If you want the MsgBox to display the value contained in the first column of your recordset, you can do it this way ...
MsgBox b(0)
However, you don't really need to open a recordset to retrieve that single value. You could use a DLookup expression instead.
MsgBox DLookup("col1", "table1", "id = 1")
Like Matteo mentioned you need to pass a String or something that can be converted to a String to MsgBox. In this case you can specify the field in your select query.
Private Sub Form_Load()
Dim a As String
Dim b As DAO.Recordset
a = " select col1 from table1 where id = 1 "
Set b = CurrentDb.OpenRecordset(a)
MsgBox b.Fields("col1") ' Msgbox b("col1") should also work
b.Close
End Sub
i have an access form consisting of a textbox , i need to check the last word of it and if this word is one of many words (array or a table column ) do an action , and this check will occurs in after_update event , something like
Private Sub textbox_AfterUpdate()
Dim txt As String
Dim lastword As String
txt = TextBox.Value
lastword= Right(txt, Len(txt) - InStrRev(txt, " "))
if lastword in (array() or column in a table) then
' do an action
End If
End Sub
we can also us an external function , could you help me with it ??
Looks like you got the function for the last word already... Now for the search in an array and table use this:
Function isInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
and
Function isColumnName(stringToBeFound As String, tableName As String) As Boolean
Dim db As Database
Dim rs1 As DAO.Recordset
Set db = CurrentDb()
Set rs1 = db.OpenRecordset(tableName)
isColumnName = False
Dim fld As DAO.Field
do until rs1.EOF
if rs1.Fields.Item(0).Value = stringToBeFound then
isColumnName = true
exit loop
end if
rs1.moveNext
loop
Set fld = Nothing
End Function
usage:
if isInArray(lastWord, youArray) or isColumnName(lastWord, "yourTable")
MsgBox "The word is already used!"
end if
How about something like this:
Private Sub TextBox1_AfterUpdate()
Dim txtStr As String
Dim vWords, v
txtStr = TextBox1.Text
If InStr(txtStr, " ") > 0 Then
txtStr = Right(txtStr, Len(txt) - InStrRev(txt, " "))
End If
vWords = Split("word1 word2 word3 word4", " ") ' fill vWords with the words you need
For Each v In vWords
If v = txtStr Then
' do an action
Exit For
End If
Next
End Sub
Dim lastcomp As String
Dim qty As Integer
Dim rs As New ADODB.Recordset
rs.Open "select Prem1Item,Prem1Qty from [TU FAR Before VB] order by Prem1Item", accCon
Do While Not rs.EOF
If Not IsNull(rs(0).Value) Then
If rs(0).Value <> "n/a" Then
If rs(0).Value <> "" Then
premlist.AddItem rs(0).Value & Format(rs(1).Value, "00")
End If
End If
End If
rs.MoveNext
Loop
rs.Close
Dim i As Integer
Dim j As Integer
i = 1
For i = 1 To premlist.ListCount
For j = 1 To finallist.ListCount
**If Not finallist(j) = premlist(i) Or finallist(j) = "" Then**
finallist.AddItem premlist(i)
End If
Next j
Next i
AccessConnection ("Close")
End If
I am trying to take the records and pull all of the items in Prem1Item and condense then down to not show duplicates and also get the amount from Prem1Qty and show the total of each item it finds. I was trying to put them in these listboxs and then export them to a table that has 2 columns (Premium and Sum)
I am getting error 13 Type mismatch highlighting the area I have put in Bold ("If Not finalist(j) = premlist(i) Or finalist(j) = "" Then"). My plans were to get that list populated and then fill the table to generate my report with.
A list box object does not allow you to retrieve row values with an index value, like you would for an array, or a VBA Collection, or a recordset Fields collection, and so on.
There is probably a better way to say that, but I don't know how. But attempts such as the following will throw that "Type Mismatch" error ...
Debug.Print Me.finallist(1)
Debug.Print TypeName(Me.finallist(1))
If you want to retrieve the bound column value from each of the list box's rows, use the ItemData property.
Dim i As Long
For i = 0 To (Me.finallist.ListCount - 1)
Debug.Print Me.finallist.ItemData(i)
Next
Debug.Print "done"
I think you should try adding the .value to your comparrison e.g.
finallist(j).value = premlist(i).value