The table is named [Sheet1$]
We are working with the first column, [F1], which is populated with random numbers ranging in value from 1-20. The entire column, all 1,048,576 rows, are filled.
I want to find the percentage of rows with a value of 19
I can make separate subqueries and divide:
"Select Count([F1]) From [Sheet1$] Where [F1]=19;"
divided by
"Select Count([F1]) from [Sheet1$]
But I want to fit both queries into a single query.
EDIT:
It looks like the OLEDB precludes the use of CASE WHEN statements, but we can use IIF() statemnts
https://stackoverflow.com/a/1742005/9721351
Option Explicit
Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
Sub main()
Dim started As Long
Dim ended As Long
Dim cn As ADODB.Connection
Dim abcCount As Long
Dim pbcCount As Long
Dim strFile As String
Dim filePath As String
Dim inputDirectoryToScanForFile As String
started = timeGetTime
filePath = "Z:\Test\Test1.xlsx"
Set cn = New ADODB.Connection
cn.Open _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source='" & filePath & "';" & _
"Extended Properties=""Excel 12.0 Macro;HDR=No;IMEX=1;"";"
Debug.Print findCount(cn)
cn.Close
Set cn = Nothing
ended = timeGetTime
Debug.Print "Sum found in " & (ended - started) / 1000 & " seconds"
End Sub
Function findCount(ByRef cn As ADODB.Connection) As Long
On Error GoTo CleanFail:
Dim strSql As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
strSql = "Select Count([F1]) from [Sheet1$] where [F1]=19;"
rs.Open strSql, cn
findCount = rs.GetString
rs.Close
Set rs = Nothing
Exit Function
CleanFail:
Debug.Print "nothing in file"
End Function
SELECT SUM(IIF([F1] = 19, 1 ,0)) *100.0 / SUM(IIF([F1] <> Null,1,0)) from [Sheet1$]
Related
I am trying to create a macro that pulls data from a user-chosen workbook.
What I need is: 1) prompt user to choose which file they want to use 2) [Assuming a "Data" sheet always exists and has the same format] select * from Data worksheet where a condition is met 3) Output this in my excel file
My code is
Sub ConnectionToExcel()
Dim rstResult As ADODB.Recordset
Dim strConnectin As String
Dim strPath As String
Dim strSQL As String
strPath = Application.GetOpenFilename
strConnectin = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source='" & strPath & "';Extended Properties=""Excel 12.0 XML;HDR=YES;IMEX=0"" "
Debug.Print strConnectin
strSQL = "SELECT * FROM [Data$] "
Set rstResult = New ADODB.Recordset
rstResult.Open strSQL, strConnectin
'adOpenForwardOnly , adLockReadOnly, adCmdText
Sheets("Export").Range("A2").CopyFromRecordset rstResult
End Sub
I am not sure how to add the condition in the select statement. The condition would be to select the items based on a given value in one of the cols. So for example, Select * from table where Product=Banana"
ID Product
14243 Apple
43543 Banana
43432 Banana
Thanks
I tried a couple of if statements,
if worksheets(Data).range("A1:A220000")="Condition" then
strSQL = "SELECT * FROM [Data$] "
end if
I also tried adding a where clause in the select statement but doesn't seem to work either
You can try this, using Data$.Product='Banana' as WHERE clause.
Sub ConnectionToExcel()
Dim rstResult As ADODB.Recordset
Dim strConnectin As String
Dim strPath As String
Dim strSQL As String
strPath = Application.GetOpenFilename
strConnectin = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source='" & strPath & "';Extended Properties=""Excel 12.0 XML;HDR=YES;IMEX=0"" "
Debug.Print strConnectin
strSQL = "SELECT * FROM [Data$] WHERE (Data$.Product='Banana')"
Set rstResult = New ADODB.Recordset
rstResult.Open strSQL, strConnectin
'adOpenForwardOnly , adLockReadOnly, adCmdText
Sheets("Export").Range("A2").CopyFromRecordset rstResult
End Sub
I am newbie in connection of vba (excel) and oracle database. I have tried to look for some information but I could not find anything that would work for me.
I want to write a query that will return me only rows in which there is a specific values.
My query looks like this:
SQLStr = SQLStr = "SELECT NGKHFHCD, NGKHFNAM, NGKHGNKA, NGKHSZIC, NGKHMTRC, NGKHSNZC, NGKHGCHC, NGKHKKKS, NGKHKTKS FROM NGKH order by NGKHFHCD"
But I want to have something that will be like this SQLStr = "SELECT NGKHFHCD, NGKHFNAM, NGKHGNKA, NGKHSZIC, NGKHMTRC, NGKHSNZC, NGKHGCHC, NGKHKKKS, NGKHKTKS FROM NGKH WHERE NGKHFHCD = SHeet1(A2:A)"
I just don't want to pull out whole table from oracle, because it will take a lots of time so I thought that maybe I can return only specific rows from that table.
Also if there is no searched value in the table I would like to mark it in someway.
Is there anyway to solve it?
my code:
Sub OracleLocalConnect()
Dim RecordSet As New ADODB.RecordSet
Dim con As New ADODB.Connection
Dim ExcelRange As Range
Dim SQLStr As String
Dim ws As Worksheet
con.ConnectionString = "Provider=OraOLEDB.Oracle.1;User ID=***;Password=****;Data Source=*****;"
con.Open
Set RecordSet = CreateObject("ADODB.Recordset")
SQLStr = "SELECT GNKHFHCD, GNKHFNAM, GNKHGNKA, GNKHSZIC, GNKHMTRC, GNKHSNZC, GNKHGCHC, GNKHKKKS, GNKHKTKS FROM GNKH ORDER BY GNKHFHCD"
RecordSet.Open SQLStr, con, adOpenStatic, adLockReadOnly
Set ws = ActiveWorkbook.Sheets("Prices")
Set ExcelRange = ws.Range("A2")
ExcelRange.CopyFromRecordset RecordSet
RecordSet.Close
con.Close
Exit Sub
Exit Sub
End Sub
Untested but this would be close:
Sub OracleLocalConnect()
Dim RecordSet As New ADODB.RecordSet
Dim con As New ADODB.Connection
Dim ExcelRange As Range
Dim SQLStr As String
Dim ws As Worksheet
con.ConnectionString = "Provider=OraOLEDB.Oracle.1;User ID=***;Password=****;Data Source=*****;"
con.Open
Set RecordSet = CreateObject("ADODB.Recordset")
SQLStr = " SELECT GNKHFHCD, GNKHFNAM, GNKHGNKA, GNKHSZIC, GNKHMTRC, " & _
" GNKHSNZC, GNKHGCHC, GNKHKKKS, GNKHKTKS FROM GNKH " & _
" where " & InClause(Sheet1.Range("A2:A1000"), "GNKHFHCD", True) & _
" ORDER BY GNKHFHCD "
RecordSet.Open SQLStr, con, adOpenStatic, adLockReadOnly
Set ws = ActiveWorkbook.Sheets("Prices")
Set ExcelRange = ws.Range("A2")
ExcelRange.CopyFromRecordset RecordSet
RecordSet.Close
con.Close
End Sub
'Create an in clause for an Oracle query
Function InClause(rng As Range, colName As String, Optional quoted As Boolean = False)
'https://stackoverflow.com/questions/400255/how-to-put-more-than-1000-values-into-an-oracle-in-clause
Dim s As String, c As Range, qt As String, sep As String
qt = IIf(quoted, "'", "")
sep = ""
s = "(999, " & colName & ") in ("
For Each c In rng.Cells
If Len(c.Value) > 0 Then
s = s & sep & vbLf & "(999," & qt & c.Value & qt & ")"
sep = "," 'add comma after first pass
End If
Next c
InClause = s & ")"
End Function
I have a macro for updating an SQL table in an Excel Add-in.
In order to use the same macro from multiple files I want to be able to create the recordset outside of the connection and then send it as a parameter to the update macro. Is this possible?
I have tried looking at the solutions found for in memory recordsets but these seemes to focus more on creating the columns rather than column-value pairs.
Sub test()
Dim ws As Worksheet
Dim serverName As String
Dim dataBase As String
Dim forecastDate As Date
Dim projectNum As Long
Dim SqlStr As String
Dim rst As New ADODB.Recordset
Set ws = ActiveSheet
serverName = "Servername"
dataBase = "database"
forecastDate = ws.Cells(2, "B").Value
projectNum = ws.Cells(3, "B").Value
SqlStr = "SELECT * From forecast WHERE forecastDate='" & forecastDate & "' AND projectNum = '" & projectNum & "';"
Set rst = New ADODB.Recordset
rst!forecastDate = forecastDate
rst!projectNum = projectNum
rst!Data = Cells(4, "B").Value
Application.Run "updateMacro", serverName, dataBase, SqlStr, rst
rst.Close
End Sub
'Part of the updateMacro:
Set conn = New ADODB.Connection
cs = "DRIVER=SQL Server;DATABASE=" & dataBase & ";SERVER=" & serverName & ";Trusted_connection=yes;"
conn.Open cs
'Set rst = New ADODB.Recordset
rst.Open SqlStr, conn, adOpenDynamic, adLockOptimistic 'adLockPessimistic
If rst.EOF Then
rst.AddNew
End If
'get the recordset from caller macro and update
rst.Update
rst.Close
Set rst = Nothing
conn.Close
Set conn = Nothing
I would like to create the recordset outside of the updateMacro and use it in that macro or create some sort of column-value pairs that could be copied to the recordset in the updateMacro.
You can declare the recordset as global or also pass the recordset between functions/subs. Please see code below for an example:
Option Explicit
'Global Recordset to be sued by other functions
Private rsMain As ADODB.Recordset
Public Function ImportData(ByVal fyYear As String) As Long
Dim sConnString As String, sqlYears As String
Dim conn As ADODB.Connection
Dim tCount As Long
sConnString = "Provider=SQLOLEDB;Data Source=server2;" & "Initial Catalog=FPSA;" & "Integrated Security=SSPI;"
sqlYears = "select ltrim(rtrim(FinYearDesc)) as FinYearDesc, Month, AccountType, ltrim(rtrim(AccountName))as AccountName, " & _
"ActualValue, BudgetValue from [GL_AccountMovements] where FinYearDesc >= '" & fyYear & "'"
Set conn = New ADODB.Connection
Set rsMain = New ADODB.Recordset
rsMain.CursorLocation = adUseClient
rsMain.Open sqlYears, conn, _
ADODB.adOpenForwardOnly, _
ADODB.adLockBatchOptimistic
Set rsMain.ActiveConnection = Nothing
conn.Close
If Not rsMain.EOF Then
tCount = rsMain.RecordCount
End If
ImportData = tCount
End Function
'An example of using Global Recordset
Function GetAccountsByYearMonth(ByVal strYTDLastYear as String) As Double
Dim lastYearYTDAct As Double
rsMain.Filter = strYTDLastYear
Do While Not rsMain.EOF
lastYearYTDAct = lastYearYTDAct + rsMain.Fields("ActualValue")
rsMain.MoveNext
Loop
GetAccountsByYearMonth = lastYearYTDAct
End Function
Thanks
A very simple query function that takes in a path for a source CSV file and a SQL statement as a string (I'm also transposing the data from the VBA function),
Public Function RunQuery(FilePath As String, SQLStatement As String)
Dim Conn As New ADODB.Connection
Dim RecSet As New ADODB.Recordset
With Conn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & FilePath & ";" & _
"Extended Properties=""text;HDR=Yes;FMT=Delimited;IMEX=1"""
End With
Conn.Open
RecSet.Open SQLStatement, Conn
RecSet.MoveFirst
RunQuery = RecSet.GetRows()
Conn.Close
Set RecSet = Nothing
Set Conn = Nothing
End Function
This code works intermittently against a CSV files, some data is retrieved correctly and some is not.
An example are these two CSV files - Abbreviated and Full. The following SQL query works perfectly on the Abbreviated file, but returns #VALUE on the Full file.
SELECT birthYear FROM [File]
It's definitely not a data limit/size issue as the Full file only contains 1800 rows. I'm completely befuddled and would appreciate any thoughts/pointers.
Incidentally if I wrap up the logic into a Sub rather than a UDF then it works perfectly without any errors,
Public Sub RunQuerySub()
Dim Conn As New ADODB.Connection
Dim RecSet As New ADODB.Recordset
Dim FilePath As String
FilePath = ActiveSheet.Range("Path")
With Conn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & FilePath & ";" & _
"Extended Properties=""text;HDR=Yes;FMT=Delimited;IMEX=1"""
End With
Dim SQLStatement As String
SQLStatement = ActiveSheet.Range("SQL")
Conn.Open
RecSet.Open SQLStatement, Conn
ActiveSheet.Cells(1, 8).CopyFromRecordset RecSet
Conn.Close
Set RecSet = Nothing
Set Conn = Nothing
End Sub
I am very confused, and would appreciate any pointers.
I adapted the technique for using a Sub and managed to get a Function which returns an array for both abbreviated and full files.
Highlight a range of 1892 cells in a column & use this array function
=RunQuery("C:\stackoverflow", "SELECT birthYear FROM [full.csv]")
This is the function. It replaces Null values in the resultset with zero.
Public Function RunQuery(FilePath As String, SQLStatement As String)
Dim Conn As New ADODB.Connection
Dim RecSet As New ADODB.Recordset
Dim rows As Variant
On Error GoTo ErrHandler
With Conn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & FilePath & ";" & _
"Extended Properties=""text;HDR=Yes;FMT=Delimited;IMEX=1"""
End With
Conn.Open
RecSet.Open SQLStatement, Conn
RecSet.MoveFirst
rows = RecSet.GetRows()
Conn.Close
Set RecSet = Nothing
Set Conn = Nothing
Dim nrows As Integer, i As Integer, valu As Integer
nrows = UBound(rows, 2) + 1
ReDim arr2(1 To nrows, 1 To 1) As Integer
For i = 1 To nrows
If IsNull(rows(0, i - 1)) Then
valu = 0
Else
valu = rows(0, i - 1)
End If
arr2(i, 1) = valu
Next
RunQuery = arr2
Exit Function
ErrHandler:
Debug.Print Err.Number, Err.Description
Resume Next
End Function
When I suggested running it from a Sub I didn't really mean as a Sub.
I meant do something like below, where your function is unchanged and the only difference is you're running it from VBA instead of as a UDF.
When running from VBA you will be able to see any errors instead of just getting #VALUE in a worksheet cell.
Sub Tester()
Dim arr
arr = RunQuery("yourPath", "yourSQL")
End sub
Public Function RunQuery(FilePath As String, SQLStatement As String)
Dim Conn As New ADODB.Connection
Dim RecSet As New ADODB.Recordset
With Conn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & FilePath & ";" & _
"Extended Properties=""text;HDR=Yes;FMT=Delimited;IMEX=1"""
End With
Conn.Open
RecSet.Open SQLStatement, Conn
RecSet.MoveFirst
RunQuery = RecSet.GetRows()
Conn.Close
Set RecSet = Nothing
Set Conn = Nothing
End Function
This button click event handler produced the results by calling RunQuerySub. Three input parameters are defined in B2, B3. B4.
Sub Button1_Click()
Dim FilePath As String, SQLStatement As String, TargetColumn As String
FilePath = Sheet1.Range("B2").Text
SQLStatement = Sheet1.Range("B3").Text
TargetColumn = Sheet1.Range("B4").Text
Call RunQuerySub(FilePath, SQLStatement, TargetColumn)
End Sub
The subroutine is much as you had it, but there were some Null values which caused issues with assigning to a Range object, so I replaced these with zeroes. The resultset from RecSet.GetRows() is a 2D variant array with the birthYear values in the 2nd dimension. I assigned these to an array with the values in the first dimension so it would populate the range by row.
Functions don't appear to allow you to assign values to ranges - at any rate I could not find a way of doing it.
Public Sub RunQuerySub(FilePath As String, SQLStatement As String, TargetColumn As String)
Dim Conn As New ADODB.Connection
Dim RecSet As New ADODB.Recordset
Dim rows As Variant
On Error GoTo ErrHandler
With Conn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & FilePath & ";" & _
"Extended Properties=""text;HDR=Yes;FMT=Delimited;IMEX=1"""
End With
Conn.Open
RecSet.Open SQLStatement, Conn
RecSet.MoveFirst
rows = RecSet.GetRows()
Conn.Close
Set RecSet = Nothing
Set Conn = Nothing
Dim dest As Range
Dim nrows As Integer, i As Integer, valu As Integer
nrows = UBound(rows, 2) + 1
ReDim arr2(1 To nrows, 1 To 1) As Integer
For i = 1 To nrows
If IsNull(rows(0, i - 1)) Then
valu = 0
Else
valu = rows(0, i - 1)
End If
arr2(i, 1) = valu
Next
Dim rangeDefn As String
rangeDefn = TargetColumn & "1:" & TargetColumn & CStr(nrows)
With ThisWorkbook.Sheets("Sheet1")
Set dest = .Range(rangeDefn)
End With
dest = arr2
Exit Sub
ErrHandler:
Debug.Print Err.Number, Err.Description
Resume Next
End Sub
I'm trying to use a function that results a boolean after in a where in a SQL statement.
What the function does is that it verifies if the selected date is within two const dates and results a boolean. I'm having problem with the SQL syntax
Sqlstring = "Select count() from [Orders].[Date]" & _
where " & Function([Orders].[Date]) = True & ""
I'm not sure if the sql statement is correct.
Edit here's the code:
public StartDate as String
public EndDate As string
Private Function GetOrdersNumbers() As Integer
Dim rsData As ADODB.RecordSet
Dim szConnect As String
Dim szSQL As String
Dim DataSource As String
DataSource = "C:\Users\user\Desktop\db.mdb"
szConnect = "Provider=Microsoft.Jet.OLEBD.4.0;" & _
"Data Source=" & DataSource & ";" & _
"user ID=admin;password=;"
szSQL = "SELECT COUNT(*) FROM [Et_Journal Livraison Fournisseur] WHERE [Et_Journal Livraison Fournisseur].[Date] BETWEEN [#StartDate] And [#EndDate] "
Set rsData = New ADODB.RecordSet
rsData.Open szSQL, szConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
If Not rsData.EOF Then
Range("A01").CopyFromRecordset RecordSet
GetOrdersNumbers = CInt(Range("A01").Value)
End If
End Function
You did not provide information about database engine... Nevertheless
I'd suggest to use query like this:
SELECT COUNT(*)
FROM Orders
WHERE [Date] BETWEEN [#date1] AND [#date2]
where
#date1 and #date1 is a parameter
There's no reason to use function.
[EDIT]
Thank you for clarification. Have a look at below code:
Option Explicit
Sub Test()
Dim d1 As Date
Dim d2 As Date
d2 = DateSerial(2015, 1, 6)
d1 = DateAdd("MM", -3, d2)
MsgBox GetOrdersNumbers(d1, d2)
End Sub
Function GetOrdersNumbers(ByVal StartDate As Date, ByVal EndDate As Date) As Long
Dim oConn As ADODB.Connection, oRst As ADODB.Recordset
Dim sConnString As String, sQry As String
Dim retVal As Long
sConnString = "Provider=Microsoft.Jet.OLEBD.4.0;" & _
"Data Source=C:\Users\user\Desktop\db.mdb;" & _
"user ID=admin;password=;"
Set oConn = New ADODB.Connection
With oConn
.ConnectionString = sConnString
.Open
End With
sQry = "SELECT [Date] As MyDate" & vbCr & _
"FROM [Et_Journal Livraison Fournisseur]" & vbCr & _
"WHERE [Et_Journal Livraison Fournisseur].[Date] BETWEEN #" & StartDate & "# And #" & EndDate & "#"
Set rsData = New ADODB.Recordset
oRst.Open szSQL, oConn, adOpenStatic, adLockReadOnly
retVal = oRst.RecordCount
End If
Exit_GetOrdersNumbers:
On Error Resume Next
oRst.Close
Set oRst = Nothing
oConn.Close
Set oConn = Nothing
GetOrdersNumbers = retVal
Exit Function
Err_GetOrdersNumbers:
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_GetOrdersNumbers
End Function