I wasn't really sure how to word this question, so I provided steps.
Steps: (VBA-Excel)
Data gets inserted into the database. A query runs to pull all the companies who has violations and insets them into excel.
I then have a loop that takes the value of each company name and insert the cell value (Company name) into another query that retrieves emails.
The problem I have is that some companies have two emails listed. So the db query looks like this:
Company/Email
Microsoft/email1#...
Microsoft/email2#...
Sony/email#...
When the email query is ran using (hope it helps)
n = 1
Do While IsEmpty(Range("A" & n).Value) <> True 'If Cells in Col A is not empty
CSCust = Range("A" & n).Value
qryEmail = "SELECT Email FROM dbo.tblPHEmails WHERE SamplePoint LIKE '" & CSCust & "'"
Set connect = New ADODB.Connection
connect.Open (strConnectStr)
'
'Clean Stream Query
Set recordSetCSEmail = New ADODB.recordSet
recordSetCSEmail.Open qryEmail, connect
Range("C" & n).CopyFromRecordset recordSetCSEmail
n = n + 1
Loop
In Excel, this overwrites one email because it automatically inputs the values on the next row where the next company gets checked (replaced by this company's email). I wish to get the data so where it'll be like:
Company/Email/Email2
Microsoft/email1#.../email2#...
Sony/email#...
I know it's a bit long (I apologize), is this possible? Or, should I go and edit the email list in the DB to allow for each company to have more than one email field?
try adding the maximum number of rows to be copied, using:
Range("C" & n).CopyFromRecordset recordSetCSEmail, 1
I figured out a solution after going over the logic over and over. During the loop, I will just check if a extra email was stored in the cell below (no more than two emails for each company) and move it to the correct location.
Related
I have an excel sheet that I use as database, and a search form that allow user to search for information, based on some criterias, and display the filtered results in a new sheet.
I am using SQL to fetch data, and display them to the user.
I use something like top open connection, then to create a record set and pass my sql request to it
m_Connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=Yes;"";"
Set OpenRecordset = CreateObject("ADODB.Recordset")
OpenRecordset.Open sql, GetConnection(), 3, 3, &H1
Set rst = OpenRecordset("SELECT * FROM [Database$] Where " & Myconditions & ";")
Everything works fine, but I need to allow users to choose the column headers names and order that may be different from what i have in the sheet from which i make my select that i call database
We need this because users are in different countries, so the display name will be configured based on the country of the user, but also we want to allow user to change the display name and order of the fields based on their needs and because the display name may be too long (multi line).
My real "database" sheet is about 110 columns, and about 1000 records (rows).
I can't publish the real data because it's confidential, but to help you understand me, I created this example that represent what I have
let us suppose I have this "database"
the user enter this search screen to select the information he needs from the database
I wish that the user will get this result and not in the same order and display of the database
as you can see, the display names and orders of the columns in the result page is different from the "database" sheet
I would like to create a configuration page, in which the user can specify the display name he wants and the order in which he wants the fields to appears. something like that
Is there any fast way to do that directly in my Recordset in SQL/EXCEL or I should after I fetch data, change the headers in excel sheet using vba ? if so, I have to make a kind of array in vba that contains both database Names and display names and replace the names of the database by its corresponding just before I show the result page shows ?
any suggestions ?
same question about the order of the fields, how to sort them based on the order the user choosed ? any fast way ?
Thanks for anyone who can help with the best way to do that
You could do the following, it loops through the data range based on the number of rows in the range being the min and max of positions available, it looks for these rankings in turn, in column C, then checks if shown, then add's the field name and it's alias to an array. This array is then joined. So using data similar to yours, in columns of the the same ordering, I called:
GenerateOrderedSQL("table 1",range("a2:d6"),3,4) A1:D1 contained headers
This called my function
Function GenerateOrderedSQL(strInputTable As String, _
rngRangeForSelection As Excel.Range, _
lngOrderColumn As Long, _
lngShowColumn As Long) As String
Dim l As Long
Dim fPos As Long
Dim lfPos As Long
Dim a() As Variant
l = rngRangeForSelection.Rows.Count
ReDim a(l)
For fPos = 1 To l
lfPos = Application.WorksheetFunction.Match(fPos, _
rngRangeForSelection.Columns(lngOrderColumn), 0)
If rngRangeForSelection.Cells(lfPos, lngShowColumn).Value = "Yes" Then
a(fPos-1) = "[" & rngRangeForSelection.Cells(lfPos, 1) & _
"] AS [" & rngRangeForSelection.Cells(lfPos, 2) & "]"
a(fPos-1) = a(fPos-1) & IIf(fPos < l, ",", vbNullString)
End If
Next
Debug.Print "SELECT " & Join(a, vbNullString) & " FROM [" & strInputTable; "]"
End Function`
This gave the following
SELECT [Fname] AS [First Name],[Lname] AS [Last Name],[Zip] AS [Zip],[City] AS [City] FROM [table 1]
I have a code which takes data from a DB with a SQL statement with 2 WHERE conditions. What I want is to paste the recordset into sheet2 . Each recordset has 13 columns of data. Problem is, when I take the recordset and I paste them into sheet2, the pasted columns are only the first 3.To note that from column 4 to 10 there can be empty columns
Do you know what could be the problem?
UPDATE 3: Updated question and code according to feedback
'Create the SQL statement to retrieve the data from table.
With Recordset
SQL = "SELECT * FROM Data WHERE [PRini] = '" & var & "' or [QAini] = '" & var & "' "
'Create the ADODB recordset object.
Set rs = New ADODB.Recordset 'assign memory to the recordset
'ConnectionString Open '—-5 aguments—-
'Source, ActiveConnection, CursorType, LockType, Options
rs.Open SQL, cnn
'If not, write the recordset values in the sheet.
Sheet2.Range("A2").CopyFromRecordset rs 'PROBLEM: The pasted row is not the full one in access, but only the first 3 columns. from the 4th to the 10th there are no data, from 11th to 13th there are but are not taken
It's hard to know exactly the problem, and there are all sorts of things wrong with this code. The issues which may be related to your problem include:
SQL = "SELECT * FROM Data WHERE [PRini] or [QAini] = '" & var & "' " will return rows where either PRini is TRUE or QAini = var. Did you mean SQL = "SELECT * FROM Data WHERE [PRini] = '" & var & "' or [QAini] = '" & var & "' " - i.e. where PRini = var or QAini = var?
the autofilter is applied to the table "Table1", but there is nothing to say this table has the same dimensions as the recordset in either direction (copyFromRecordset does not create or populate a table, it just pastes the values straight in to the worksheet). If you need the data in a table, use the QueryTable.Connection, QueryTable.CommandType and QueryTable.CommandText properties to connect the table to the SQL server directly (see the MSDN docs). Or apply the autofilter to the range containing the data (Sheet2.Range("A2").CurrentRegion will do).
there is nothing in the code that references the current date. The code from 'Filter for the date onwards just copies the visible cells from the first two columns into a listBox control.
Why not include the date condition in the SQL? That would be the approach I would use (e.g. SELECT * FROM Data WHERE ([PRini] = 'something' OR [QAini] = 'something') AND [MyDateColumn] < DATE();)
I have a long list of data on an excel table. This data includes detail information of each order in several rows. There is a column shows the status of each row. Also, I have a dashboard which just lists out the order names. I want the users to be able to see a short statistical info of each book as a comment or when they mouse over the cell, if possible or as a cell data. The info could be something like underneath sample in 3 or 4 row. (The number of items is the count of rows with the same status)
5 issued item
3 shortage items
2 Done items
X other
If you just give me the general idea it would be great.
I think I have to use a collection procedure, something like "scripting dictionary" but I have no experience using them. I know how to do that by putting a case statement after if clause inside a loop, but I am looking for a smarter way. you can find some pictures and a sample data below: sample pictures
For the record, I came to this answer from one of friends in MrExcel froum. Hope you find it usefull.
The just difference is, I was looking for a momentum reply just for an active cell, but this code, provide all the information for all the order names as a comment. but it is very easy to adjust!
Sub UpdateComments()
Dim c As Variant, strComment As String
Dim intISSUED As Integer, intSHORTAGE As Integer
Dim tblDATA As ListObject, tblDASH As ListObject
Set tblDATA = Application.Range("TBL.data").ListObject 'adjust Table Name
Set tblDASH = Application.Range("TBL.dash").ListObject 'adjust Table Name
For Each c In tblDASH.ListColumns("W/B").DataBodyRange
strComment = ""
intISSUED = Application.CountIfs(tblDATA.ListColumns("Work Book").DataBodyRange, c, tblDATA.ListColumns("Stage").DataBodyRange, "Issued")
strComment = strComment & Chr(10) & "Issued: " & intISSUED
intSHORTAGE = Application.CountIfs(tblDATA.ListColumns("Work Book").DataBodyRange, c,tblDATA.ListColumns("Stage").DataBodyRange, "Shortage")
strComment = strComment & Chr(10) & "Shortage: " & intSHORTAGE
' ADDITIONAL 'STAGES' HERE
' OR put 'stages' in array to condense code
With Sheets(tblDASH.Parent.Name).Range(c.Address)
If .Comment Is Nothing Then
.AddComment
.Comment.Visible = False
End If
.Comment.Text Text:=Mid(strComment, 2)
End With
Next c
End Sub
Who can help a beginner out. I've added two screenshots to make my story clearer.
My excel sheet is two tabs. One is 'calculation' and other is 'project'.
What i'd like to know is how to program the following in vba:
In the calculation tab there is a employee number in column E. I have to look if that number also is written in the projects tab. If so i need to know if the date of the calculation tab falls within the start and end date in the projects tab. If so then write the info if that row to the empty columns in the calculation tab.
Another problem arises when an employee works multiple jobs in the projects tab. I guess there needs to be another loop in here:
If the date from calculation tab doesn't fall in the period from start to end in the projects tab, is there another row with the same employee number and maybe it falls within that period.
I hope i made my story clear. I know what the steps should be, just not how to program it. I hope someone is able to help me with this.
Since your screenshots appear to be Excel for Windows consider an SQL solution using Windows' JET/ACE Engine (.dll files) as you simply need to join the two worksheets with a WHERE clause for date filter. In this approach you avoid any need for looping and use of arrays/collections.
To integrate below, add a new worksheet called RESULTS as SQL queries on workbooks are read-only operations and do not update existing data. A LEFT JOIN is used to keep all records in Calculations regardless of matches in Projects but matched data will populate in empty columns. Results should structurally replicate Calculations. Adjust column names in SELECT, ON, and WHERE clauses as required (as I cannot clearly read column names from screenshots). Finally, a very important item: be sure date columns are formatted as Date type.
Dim conn As Object, rst As Object
Dim strConnection As String, strSQL As String
Dim i As Integer
Set conn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
' OPEN DB CONNECTION
strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _ '
& "DBQ=C:\Path\To\Workbook.xlsx;"
conn.Open strConnection
' OPEN QUERY RECRDSET
strSQL = "SELECT t1.*, t2.[Project] AS [Which Project], t2.[Customer] As [Which Customer]," _
& " t2.[Start], t2.[End planned], t2.[Hours per week]" _
& " FROM [Calculation$A$3:$D$1048576] t1" _
& " LEFT JOIN [Projects$A$3:$J$1048576] t2" _
& " ON t1.EmployeeNum = t2.EmployeeNum" _
& " WHERE t1.[Date] BETWEEN t2.Start AND t2.[End planned];"
rst.Open strSQL, conn
' COLUMNS
For i = 1 To rst.Fields.Count Worksheets("RESULTS").Cells(3, i) =
rst.Fields(i - 1).Name
Next i
' DATA ROWS
Worksheets("RESULTS").Range("A4").CopyFromRecordset rst
rst.Close
conn.Close
Set rst = Nothing
Set conn = Nothing
it would be great to let us know, what you have done so far. I think the easiest way for a beginner is to just use two loops. One for the calculation and one for the projects tab.
Then you can start to develop your functionality. Use a "row counter" for each worksheet and iterate trough the rows. Here is an example pseudo code:
Dim lRowCountCalc as Long
Dim lRowCountPrj as Long
lRowCountCalc = 1
lRowCountPrj = 1
do
do
If Table2.Range("A" & lRowCountPrj).Value = Table1.Range("E" & lRowCountPrj).Value Then
If ... dates are equal
'Do some stuff
End if
End If
lRowCountPrj = lRowCountPrj +1
Loop Until lRowCountPrj = 5000 Or Table2.Range("A" & lRowCountPrj).text = ""
lRowCountCalc = lRowCountCalc +1
Loop Until lRowCountCalc = 5000 Or Table1.Range("A" & lRowCountCalc).text = ""
Just check for each employee number in calculation if there is a the same number in the current row in projects. If so, do your checks and fill in the information you need. If there is more than one project, you will find it also because all rows will be checked.
But be careful. This is very expensive because this code iterates for each row in projects over all rows in calculation. But for the beginning I would do it like this.
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