One aspect of my project involves comparing the part number entered by the operator to a predetermined list of part numbers in a column in a database. Right now, my program is telling me that every part number entered in the spreadsheet (50+) does not match any in the database, which I've verified to be incorrect. I've checked that both the spreadsheet part number and the database part number are of string datatype. I've doublechecked that my looping logic is good, and to me seems like it should work. To the best of my knowledge there are no hidden characters in either the database cells or in the spreadsheet cells. I'm completely stumped at this point as to why my program doesn't detect any matches between the spreadsheet and the database. Below is the Sub containing the code for checking that the part numbers match:
Sub CheckPN()
'Connect to the E2 database
Call SetPNConnection
'Open a recordset
Set PNRecordset = New ADODB.Recordset
PNRecordset.Open "EstimRpt", PNConnection, adOpenKeyset, adLockOptimistic, adCmdTable
PNSQLCmd = "SELECT DISTINCT [PartNo] FROM EstimRpt;"
'Loop through data, comparing part numbers to E2 database part number records
TotalBadPNCount = 0
With PNRecordset
For DataRowCount = 2 To TrackingLastRow
PNCount = 0
Part_Number = Tracking.Sheets("Operator Data").Range("A" & DataRowCount).Value
'MsgBox "The datatype for " & Part_Number & " is " & VarType(Part_Number) & "."
Do Until .EOF
'MsgBox "The datatype for " & .Fields("PartNo").Value & " is " & VarType(.Fields("PartNo").Value) & "."
If Part_Number = .Fields("PartNo").Value Then
'If .Fields("PartNo").Value = Part_Number Then
MsgBox Part_Number & " is a match."
PNCount = PNCount + 1
End If
.MoveNext
Loop
If PNCount < 1 Then
MsgBox "The P/N " & Part_Number & " entered in cell A" & DataRowCount & " is incorrect. Please correctly enter the P/N and re-run the program."
TotalBadPNCount = TotalBadPNCount + 1
End If
Next DataRowCount
If TotalBadPNCount >= 1 Then
Exit Sub
End If
End With
PNRecordset.Close
Set PNRecordset = Nothing
PNConnection.Close
Set PNConnection = Nothing
End Sub
On a side note, I'd like to have the entire program stop executing if a part number doesn't match, not just the immediate sub. Currently, just this sub exits upon no part number matches.
Thanks for the help on both of these issues.
Jordan
I'd suggest not using a loop to compare records from your user-submitted dataset to your permanent table. Instead, load the user-submitted dataset into a temporary table in your DB, and use SQL to compare the 2 tables.
You can try something along these lines:
'Load spreadsheet into temp table
<your code here>
'open recordset in order to compare PartNos
Dim db As Database
Set db = CurrentDb
Dim rs As Recordset
sSQL = "select count(*) as [count] from temp " _
& " where temp.PartNo not in (select distinct EstimRpt.PartNo from EstimRpt)"
Set rs = db.OpenRecordset(sSQL)
ctRecords = rs![Count]
'if records are found in temp table that do not exist
'in the perm table, then end execution of everything.
if ctRecords > 0 then
End
else
'run the rest of your code
<your code here>
end if
'Drop temp table
<your code here>
I found my problem at long last. The comparing records between database and spreadsheet does work now. I had to make the following changes to my code:
Instead of:
Do Until .EOF
I needed:
Do Until .EOF = True
I also needed to add the following just after the For Loop declaration:
.MoveFirst
Now my code loops correctly.
Related
So I am running a Do loop that cycles through a list. I used the 'index' function to calculate the value in the cell. I have a cell that is set up as the 'index' and another cell set up as the value, which is where the index function resides.
The script will start with 'index' = 1 the run. Once it's done, the script adds 1 to the 'index' and the script runs again. This continues until the cell is 0.
Most of the time this runs without any issues, but every once in a while the loop doesn't add correctly. So what happens is the loop occurs but without adding 1 to the index therefore staying on the same value over and over again. This will happen maybe 2 or 3 iterations before finally adding 1 to the index.
Any idea why this is happening? It's really frustrating because this is used to email a large audience with reports that are unique to user. So when it glitches like this, some users are receiving incorrect reports or multiple reports.
Thank you!
Do
y = Worksheets("index").Range("district_num")
xlsheet.Range("A2:Z150000").ClearContents
Set db = OpenDatabase(DbLoc)
SQL = "SELECT DISTINCT district_num, district_name, district_manager_name, last_name2, first_name2, " & _
"district_mgr_job_title, district_mgr_ee_id, DM_email_email_tbl " & _
"FROM Contacts " & _
"WHERE district_num = " & y
'Execute query and populate the recordset'
Set rs = db.OpenRecordset(SQL, dbOpenSnapshot)
'Paste Access data in Excel worksheet'
xlsheet.Range("A2").CopyFromRecordset rs
Application.Cursor = xlDefault
'Skips over empty zones'
If Range("A2") <> vbNullString Then
Call Sheet5.DM_auto_email
Else
Sheets("ZD_contact_list").Select 'Important to go back to the contact list so script can continue to run'
End If
Worksheets("Index").Range("district_num_index") = Worksheets("Index").Range("district_num_index") + 1
Loop Until y = 0
I have to create a text box in MS Access where users are able to see the top 3 records of a particular result set. So even if the query results in 5 records I only want it to display the top 3 records as three textboxes (sometimes the result may also be 1,2 or 0 records).
I took the easy way out and created a new subform which was connected to the parent form using master/child field. The textbox was placed in the details part of the subform and as a recordsource of the subfrom used the following query:
Select top 3 tbl1.column1, tbl1.column2
from tbl1
column1 is the control source for the textbox and column2 is the column I have used for master/child link.
Now the catch is that the query works fine when I use it without top 3. But when I use top 3 the textbox suddenly disappears and the subform is completely blank.
I am not able to identify the cause of the error. My guess is that it has something to do with type of the subform. Not sure.
Is there any other way I can have a text box whose number can vary on the basis of the results?(but limiting the resultset to 3)
Appreciate the help.
Textbox are not meant to hold more than 1 value.
You are trying to assign three results of 2 columns to one textbox(No can do).
Use listbox to populate as you are doing, assigning the query you just wrote in the rowsource of the list(no subforms needed). This way users will see the three records.
You could use a textbox in order to accomplish what you are trying to do. But will require some VBA coding to accomplish this.
Public function CombineValuesForTextBox() as string
Dim rst as dao.recordset
Dim strSQL as string
strSQL = "SELECT TOP 3 tbl1.Column1 as field1, tbl1.Column2 as field2 " & _
"FROM tbl1;"
set rst = currentdb.openrecordset(strsql)
if rst.recordcount = 0 then 'Checks if the recordset has records or not
CombineValuesForTextBox = "No records found"
goto EndCode 'Or replace with what actions to take if no records are found
else
rst.movelast 'Forces the recordset to fully load
rst.movefirst
do while not rst.eof
if CombineValuesForTextBox = "" or CombineValuesForTextBox = empty then
CombineValuesForTextBox = rst![field1] & " - " & rst![Field2]
else
CombineValuesForTextBox = CombineValuesForTextBox & vbcrlf & _
rst![field1] & " - " & rst![Field2]
end if
Loop
end if
rst.close
set rst = nothing
EndCode:
if not rst is nothing then
rst.close
set rst = nothing
end if
end function
Then on your form put in the code (be sure the textbox is unbound...)
me.textbox = CombineValuesForTextBox
I have a worksheet with ~30k rows of data and 20 columns. A lot of the values in column B are duplicates, and I would like to delete those duplicates. The problem I have is that even though column b may be a duplicate, that row's data in the rest of the columns are not necessarily a duplicate, so it's important that we only delete the row if the value in column B is a duplicate AND the value in column M = 0.
Is there a way to do do this for each row in the worksheet (the worksheet name is Test)? I imagine it involves "For Each...", but i don't have a lot of experience with that and haven't been able to find any other macros that can complete this task. Let me know if you need me to elaborate on what I am trying to accomplish.
Thanks for your help!
Here's a simple way in VBA, that queries your spreadsheet like a table. You'll have to adapt the RunQuery() method for your particular case, because I don't know your column names.
This assumes the following:
Your worksheet is laid out like a table, with column names in row 1, and data below it
You've saved your workbook before running this code
In my particular workbook, I have a Column labeled "Category", one labeled "Types", and I've added a column called "DeleteMe".
'Adapt RunQuery for your particular needs
Sub RunQuery()
'Change this SQL statement to reflect your particular need
SQL = "SELECT [Category], [Types] FROM %table(0)% GROUP BY [Category], [Types] HAVING Count(*) > 1"
'Change "Sheet2" to your sheet name
Set rs = QuerySheet(SQL, Sheet2)
Do While Not rs.EOF
SQL = "UPDATE %table(0)% SET [DeleteMe]='x' WHERE [Category]='" & rs!Category & "' AND [Types]='" & rs!Types & "'"
'Again, change Sheet2 to your sheet name
QuerySheet SQL, Sheet2
rs.MoveNext
Loop
End Sub
'You don't need to change this function
Function QuerySheet(sSQL, ParamArray Worksheets())
Dim oSh
Dim sConn, n
On Error GoTo QuerySheet_Err
Set QuerySheet = CreateObject("ADODB.Recordset")
sConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Worksheets(0).Parent.FullName & ";Extended Properties=""Excel 8.0;HDR=Yes"";"
n = 0
For Each oSh In Worksheets
sSQL = Replace(sSQL, "%table(" & n & ")%", "[" & oSh.Name & "$]")
n = n + 1
Next
QuerySheet.Open sSQL, sConn
Exit Function
QuerySheet_Err:
MsgBox "Error in QuerySheet(): " & Err.Description
End
End Function
Source
The code updates the "DeleteMe" column with an x. Now, you can sort by the "DeleteMe", and delete the rows (or write a simple VBA statement to do that).
Your RunQuery() method will need to look more like this, replacing "column B" and "column M" with the names of the fields in your sheet's header row:
...
'Change this SQL statement to reflect your particular need
SQL = "SELECT [column B] FROM %table(0)% WHERE [column M] = 0 GROUP BY [column B] HAVING Count(*) > 1"
'Change "Sheet2" to your sheet name
Set rs = QuerySheet(SQL, Sheet2)
Do While Not rs.EOF
SQL = "UPDATE %table(0)% SET [DeleteMe]='x' " & _
" WHERE " & _
IIf(IsNull(rs![column B]), _
" [column B] IS NULL", _
" [column B]='" & rs![column B] & "' ") & _
" AND [column M]=0"
'Again, change Sheet2 to your sheet name
QuerySheet SQL, Sheet2
...
Note: Sometimes you get debug errors when you change the names of the worksheets from "Sheet1" to something else... Haven't worked that issue out yet. But this works well for "Quick N' Dirty" queries.
Unless you need to frequently repeat the same process, you can also just filter those rows that match your criteria and manually delete them.
Provided your data is sorted based on column B, you can add a formula in column M that compares the values for each cell in column B with the value above and below to identify duplicates.
The following formula will check if cell B matches value above OR below AND if column M=0 and result in True/False.
=AND(OR(B2=B1,B2=B3), M2=0)
You could try this without VBA:
Add a column with formula
=B1&IF(M1=0,"",RAND()*9999999)
This will create a unique entry if M1=0
Copy paste the new column to values
Do the regular 'Remove duplicates' routine, based on the new column.
Remove the new column
This kind of hard to explain specially since english is not my first language, let's see if can make myself understand, im trying to perform a Select query to get the records within a time frame(column ContactDate contains the date/time values) the query is as follow:
SELECT Val([ACD_ID] & Format(DateValue([ContactDate]),'0')) AS SEARCH_CODE, CFinal, 1 AS Expr1,
COPCFCR, FCRPossible, RecordName
FROM [YTD-Daily_Report]
WHERE ((([YTD-Daily_Report].[ContactDate])>=#9/01/2014#
And ([YTD-Daily_Report].[ContactDate])<=#10/01/2014#));
In the source Table(YTD-Daily_Report) COPCFCR and FCRPossible are define as Checkboxes(true or false), when i run this query using Access within the database it all works well i get a column with the concatenated value of the ID + Date, a column containing the score, a column with a 1 in it, a column with the COPCFCR value(true or false), a column with the FCRPossible value(true or false), and column with the RecordName, at this point if i compared with the values on the table they match 100%.
Now, i took this query and put it on an Excel workbook but when it runs it returns the values for the columns COPCFCR and FCRPossible wrong, sometimes a false is returned as true or viceversa and other times the values match 100% with the corresponding values on the source table, for example in some rows COPCFCR is returned as true when it should be false according to the source table.
Here is the Excel VBA code I'm using:
Dim rsSource As New Recordset
Dim m_Connection As New Connection
Dim rngTarget as range
dim result as long
m_Connection.Provider = "Microsoft.ACE.OLEDB.12.0"
m_Connection.Open "Path and name of the Database"
strQuery = "SELECT Val([ACD_ID] & Format(DateValue([ContactDate]),'0')) AS SEARCH_CODE, CFinal, 1 AS Expr1, COPCFCR, FCRPossible, RecordName" & Chr(13) & _
"FROM [YTD-Daily_Report]" & Chr(13) & _
"WHERE ((([YTD-Daily_Report].[ContactDate])>=#" & Format(START_DATE, "m/dd/yyyy") & "# And ([YTD-Daily_Report].[ContactDate])<=#" & Format(STOP_DATE + 1, "m/dd/yyyy") & "#));"
rsSource.Open strQuery, m_Connection, adOpenForwardOnly, adLockReadOnly
Set rngTarget = Range("A2")
result = rngTarget.CopyFromRecordset(rsSource)
If rsSource.State Then rsSource.Close
Set rsSource = Nothing
If m_Connection.State Then m_Connection.Close
Set m_Connection = Nothing
Any ideas what could be happening?
It seems the database file was corrupted and this caused the data to be exported in a different way that it was call for. The query is working fine as it is.
I normally do most of this work in Excel 2007, but I do not think excel is the right tool for managing the data that I need to process. So I am trying to convert an excel spreadsheet to an Access 2007 db which I can do with no problem, but before doing anything to the spreadsheet I go through the process of cleaning up the data in it in order to use the resulting information. In excel I use a macro such as the following
Sub deletedExceptions_row()
Dim i As Long
Dim ws As Worksheet
On Error GoTo whoa
Set ws = Sheets("data")
With ws
For i = .Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If .Cells(i, 3) = "" Or _
VBA.Left(.Cells(i, 3), 4) = "511-" Or _
VBA.Left(.Cells(i, 3), 5) = "CARL-" Then
.Rows(i).Delete
End If
Next i
End With
Exit Sub
whoa:
MsgBox "Value of i is " & i
End Sub
to remove unnecessary records in the spreadsheet how would I accomplish the same thing in Access 2007.
The macro is looking for particular parts or rather the first few characters of the record's 3rd field in order to determine if the whole record needs to be removed (ex. 511-QWTY-SVP or CARL-52589-00). In all there about 180 such character types that affect 1000's of rows that need to be removed from the spreadsheet, but I would like to replicate that same process in Access 2007, but do not know how.
Thank you all for your assistance with this problem
Within Access you can execute a DELETE statement to discard rows where the value in a field is an empty string ("") or matches one of your patterns.
DELETE FROM YourTable
WHERE
YourField = ""
OR YourField ALike "511-%"
OR YourField ALike "CARL-%";
With YourField indexed, that pattern matching in the WHERE clause offers a potentially large performance improvement over a query using the Left() function such as your spreadsheet macro used. IOW, the following query would require the db engine to run those Left() expressions on every row of YourTable. But with the query above and YourField indexed, the db engine could simply select the matching rows ... which can easily be an order of magnitude faster.
DELETE FROM YourTable
WHERE
YourField = ""
OR Left(YourField, 4) = "511-"
OR Left(YourField, 5) = "CARL-";
Sub DeleteRows(strVal as string)
strVal = Trim(strVal)
if strVal = "" then exit sub
dim dbs as Database
set dbs = CurrentDB
dbs.execute "Delete * FROM YOURTABLE where YOURFIELD Like '" & strVal & "*'"
set dbs = Nothing
End Sub
then call it for each item
DeleteRows("Carl-")
DeleteRows("511-")
Given that you have 180 possible problem rows, it may make sense to create a problem list table. For example:
ExcelImport
ID ARow
1 Carl-abdre
2 511-ferw2
3 wywr-carl
4 123-456
ProblemList
Problem
511-
Carl-
Query
DELETE
FROM ExcelImport
WHERE ExcelImport.ID In (
SELECT ID
FROM ExcelImport, ProblemList
WHERE ARow Like [Problem] & "*" Or ARow & ""="")
ExcelImport after query
ID ARow
3 wywr-carl
4 123-456
You manage database data using the SQL language. For Access, check:
http://msdn.microsoft.com/en-us/library/bb177896%28v=office.12%29.aspx
Sub DeleteX()
Dim dbs As Database, rst As Recordset
Set dbs = OpenDatabase("Northwind.mdb")
dbs.Execute "DELETE * FROM " _
& "Employees WHERE Title ALike 'FOOBAR-%';"
dbs.Close
End Sub