I am trying to select a single cell value in an excel spreadsheet named "AtwickShortfall" as follow
StrSql = "SELECT AtwickShortfall FROM [" & Glob_WsheetNameTradeLogOpsActions & "$AtwickShortfall]"
obviously does not work; can someone tell me the correct syntax ?
AtwickShortfall cell value is the sum of other values in the speadsheet; there are no tables in this spreadsheet at all.
UPDATE 1
tried this syntax
StrSql = "SELECT [AtwickShortfall] FROM [" & Glob_WsheetNameTradeLogOpsActions & "$]"
I get an error "No value given for one or more required parameters"
UPDATE 2
after amending my code as per #Dick Kusleika answer I now have this code
StrSql = "SELECT * FROM [AtwickShortfall]" ' & Glob_WsheetNameTradeLogOpsActions & "$AH34]"
Debug.Print (StrSql)
Set RecSet = ConnObj.Execute(StrSql)
If Not (RecSet Is Nothing) Then
With RecSet
If Not (.BOF) And Not (.EOF) Then
Debug.Print RecSet.Fields(0).Value
Else
'UdtKpi.HornInjMeterSum = 0
End If
End If
End With
End If
no errors but the recodset is empty (BOF is true); the value of AtwickShortfall is a formula that gives 0 at the moment. I also tried to remove the formula and fill the cell with 0 but same result: recordset BOF is true
UPDATE 3
I found a solution but please have a look at the screenshot below
cell AtwickShortfall is the one that I have now added a value of 125 on the column AH why this code work ?
StrSql = "SELECT Atw FROM [Operational_Actions$AH33:AH34]"
why it recognize the "atw" as a header of the range I gave??
If I change the above query to
StrSql = "SELECT Atw FROM [Operational_Actions$AH34:AH34]"
I get an epty recordset; It does not make sense how excel works to me; note that I have not implemented the worksheet data, it has been given to me
I think because the named range is at the workbook level (rather than worksheet level) that you can't specify what worksheet it's on. It's looking for a worksheet level named range when you specify the worksheet. This worked for me.
Sub getcell()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=\\99991-dc01\99991\dkusleika\My Documents\testadonamedrange.xlsx;Extended Properties=""Excel 12.0 Xml;HDR=NO"";"
Set rs = cn.Execute("select * from [AtwickShortfall]")
Debug.Print rs.Fields(0).Value
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub
Related
I am using an old macro that sends a defined range from Excel to an MS Access database, and would like to adapt it to send to an SQL Server database.
Old Code (works very well, I am not the author):
'ExportAccess
Dim db As DAO.Database
Dim Rst As DAO.Recordset
Dim localMDB As String 'this is the address of the access mdb, removed from this snippit
sht = ActiveCell.Worksheet.Name
With Worksheets(sht)
.Range("L1:A" & .Range("A65536").End(xlUp).Row).Name = "Range"
End With
Set db = OpenDatabase(ActiveWorkbook.FullName, False, False, "excel 8.0")
db.Execute "INSERT INTO myTable IN '" & localMDB & "' SELECT * FROM [Range]", dbFailOnError
My attempt at modification:
Dim db As DAO.Database 'sql database
Dim rs As DAO.Recordset
Dim bd As DAO.Database 'excel sheet?
Dim Rst As DAO.Recordset
Set db = OpenDatabase("myDatabase", dbDriverNoPrompt, False, "ODBC;DATABASE=DB_Backup;DSN=myDatabase")
sht = ActiveCell.Worksheet.Name
With Worksheets(sht)
.Range("B1:A" & .Range("A65536").End(xlUp).Row).Name = "Range"
End With
db.Execute "INSERT INTO myTable SELECT * FROM [Range]", dbFailOnError
When I run my attempt, it gives the error that my "range" is not defined.
Any help would be greatly appreciated, thanks!
The reason the first code block worked successfully is that you connected to the Microsoft Access Jet/ACE Engine which can query Access database tables, Excel workbooks, even CSV text files. Notice how db is set directly to an Excel workbook and the append query externally interfaces to an Access database. This syntax is only supported with the Jet/ACE Engine.
However, in second code block you are connecting to an external database, namely SQL Server, and not the Jet/ACE Engine. Therefore, the analogous syntax is not supported. Specifically, as error indicates, [Range] does not exist because you are not connected to a workbook. You will need to specify all cell data of the range in VBA for appropriate data migration. Do not conflate SQL Server with MS Office even though they are products of same company.
Consider ADO (rather than DAO) for parameterization of values. Be sure to explicitly name columns in append SQL query. While your actual range is uncertain, below loops down the first column of range and uses .Offset to walk across the columns in current row. Adjust SQL, range limits, parameters, and types to align to actual data.
Sub SQLServerAppend()
' ADD REFERENCE FOR Microsoft ActiveX Data Objects #.# Library
Dim con As ADODB.Connection, cmd As ADODB.Command
Dim cell As Range
Dim strSQL As String
Set con = New ADODB.Connection
con.Open "DSN=myDatabase"
' PREPARED STATEMENT WITH QMARK PLACEHOLDERS
strSQL = "INSERT INTO myTable (Col1, Col2, Col3, ...) " _
& " VALUES (?, ?, ?, ...)"
sht = ActiveCell.Worksheet.Name
With Worksheets(sht)
For Each cell In .Range("A1", .Range("A1").End(xlDown))
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = con
.CommandText = strSQL
.CommandType = adCmdText
' BIND PARAMETERS WITH ? IN SQL (ALIGN VALUES TO ADO TYPES)
' FIRST COLUMN OF ROW RANGE
.Parameters.Append .CreateParameter("col1param", adVarChar, adParamInput, , cell.Offset(0, 0).Value)
' SECOND COLUMN OF ROW RANGE
.Parameters.Append .CreateParameter("col2param", adDate, adParamInput, , cell.Offset(0, 1).Value)
' THIRD COLUMN OF ROW RANGE
.Parameters.Append .CreateParameter("col3param", adDecimal, adParamInput, , cell.Offset(0, 2).Value)
'... ADD OTHER COLUMNS
' RUN APPEND ACTION
.Execute
End With
Next cell
con.Close
Set cmd = Nothing: Set con = Nothing
End Sub
I've modified my code with the loop from #Parfait to make it work for me. As my DAO connection was working I decided to stick with it.
Sub ToDbase()
'Modified by ployer. This sends values from an exel spreadsheet to your sql database
'with code from Parfait https://stackoverflow.com/questions/71817166/how-do-you-insert-a-range-from-excel-to-an-sql-table
Dim db As DAO.Database 'sql database
Dim rs As DAO.Recordset
Set db = OpenDatabase("myDB", dbDriverNoPrompt, False, "ODBC;DATABASE=myDB_Backup;DSN=myDB")
Dim cell As Range
Dim Value1 As String 'First value to import
Dim Value2 As String 'Second value to import. Add more as needed with the correct types
Dim i As Integer 'for testing in my exel sheet before trying in db
Dim n As Integer 'for testing in my exel sheet before trying in db
i = 1
n = 1
sht = ActiveCell.Worksheet.Name
With Worksheets(sht)
For Each cell In .Range("A1", .Range("A1").End(xlDown))
Value1 = cell.Offset(0, 0).Value 'Assign to variable "Value1" the value stored in Cell at position 0,0 (First time through would be A1)
Value2 = cell.Offset(0, 1).Value 'Assign to variable "Value2" the value stored in Cell at position 0,0 (First time through would be B1)
'For testing if iteration works.
'Cells(i, 5).Value = Value1
'Cells(n, 6).Value = Value2
'i = i + 1
'n = n + 1
'each time we go through the loop the Value1 and Value2 get sent to Col1 and Col2 in myTable. You need to define the value of Col1, for instance, if in the db it is called Customer it needs to be written Customer here.
db.Execute "INSERT INTO myTable (Col1, Col2) Values ('" & Value1 & "','" & Value2 & "') ", dbFailOnError
Next cell
End With
End Sub
I have a code in vba through which whenever i will save any new value in a particular cell it will show in the message box that what was the old value stored in the cell and what was the new value which i have just saved below is the code for that
Option Explicit
Dim OldVals As New Dictionary
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
For Each myCell In Target
If OldVals.Exists(myCell.Address) Then
MsgBox "New value of " & Replace(myCell.Address, "$", "") & " is " & myCell.Value & "; old value was " & OldVals(myCell.Address)
Else
MsgBox "No old value for " + Replace(myCell.Address, "$", "")
End If
OldVals(myCell.Address) = myCell.Value
Next myCell
End Sub
the output window of the code will come like this in the picture below --
so i want to export the values which was displayed in the message box to the access database table using vba one after the another
however i have written a code to export and save the values of excel sheet cells into access database table the code is below
Const TARGET_DB = "\Database3.accdb"
Sub PushTableToAccess()
Dim cnn As ADODB.Connection
Dim MyConn
Dim rst As ADODB.Recordset
Dim i As Long, j As Long
Dim Rw As Long
Sheets("Sheet1").Activate
Rw = Range("A1").End(xlDown).Row
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open MyConn
End With
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open Source:="Table1", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable
For i = 2 To Rw
rst.AddNew
For j = 1 To 3
rst(j) = Cells(i, j).Value
Next j
rst.Update
Next i
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub
the above code will export and save all the values in excel cells to access database table .
but i am not sure how to combine both the codes so that my first code whenever it will display the old and new values of cell and when i click on OK button it will export and save the value displayed in message box (eg- new value of A1 is 7 ; old value was 88) to access database table one after the another .
It seems you want to make an audit/logging function of all changes to a an Excel workbook.
You have two pieces of code, one to identify the change and one to write information to a datbase, an you want to combine this. The resulting functionality wold then be to write every change the user makes to a database.
The code you have should give you enough guidance on the particular VBA statements. I'll limit this solution to the approach.
As you will need the database connection during the whole time the user has the worksheet opened, you should make the database connection in the Workbook Open event:
Public cnn As ADODB.Connection
Public MyConn
Private Sub Workbook_Open()
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open MyConn
End With
End Sub
Then you continue in the Change events:
Private Sub Worksheet_Change(ByVal Target As Range)
'.... (your code to get the change)
Set rst = New ADODB.Recordset
rst.AddNew ' allocate new record
rst(j) = Cells(i, j).Value ' populate the record (this must be your code)
rst.Update ' update/insert record
rst.Close ' done record.
End Sub
Finally you close the database in the Workbook_BeforeClose event.
Im using Access 2013 and Excel 2013. In terms of References, I am using Microsoft Office 15.0 Access database engine Object Library.
So I am trying to run an INSERT INTO query from VBA. The worksheet has a list of part numbers, which I used this code to convert into an array.
Function partArray()
Dim partList() As Variant
Dim partArr(10000) As Variant
Dim x As Long
partList = ActiveWorkbook.Worksheets("Parts").ListObjects("Parts").ListColumns("Part Number").DataBodyRange.Value
For x = LBound(partList) To UBound(partList)
partArr(x) = partList(x, 1)
Next x
partArray = partArr
End Function
Now I am trying to use an INSERT INTO query to input these part numbers into a table in access. Any idea how I can do this?
You should use ADO to connect between Excel and Access. It will be a reference under Tools/References in the VBE. Using ADO you can run SQL statements. You can define your table in Excel as the origin table and then read data from that, put them into a recordset and then write the recordset into an Access table. There are plenty of examples on the internet. You can start with this: https://www.exceltip.com/import-and-export-in-vba/export-data-from-excel-to-access-ado-using-vba-in-microsoft-excel.html
Whoa! I think your approach is totally wrong. Try something like this.
Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=C:\FolderName\DataBaseName.mdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 3 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("FieldName1") = Range("A" & r).Value
.Fields("FieldName2") = Range("B" & r).Value
.Fields("FieldNameN") = Range("C" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Or, this.
Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
Set db = OpenDatabase("C:\FolderName\DataBaseName.mdb")
' open the database
Set rs = db.OpenRecordset("TableName", dbOpenTable)
' get all records in a table
r = 3 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("FieldName1") = Range("A" & r).Value
.Fields("FieldName2") = Range("B" & r).Value
.Fields("FieldNameN") = Range("C" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub
Of course you could use the TransferSpreadsheet method if you want.
Option Explicit
Sub AccImport()
Dim acc As New Access.Application
acc.OpenCurrentDatabase "C:\Users\Public\Database1.accdb"
acc.DoCmd.TransferSpreadsheet _
TransferType:=acImport, _
SpreadSheetType:=acSpreadsheetTypeExcel12Xml, _
TableName:="tblExcelImport", _
Filename:=Application.ActiveWorkbook.FullName, _
HasFieldNames:=True, _
Range:="Folio_Data_original$A1:B10"
acc.CloseCurrentDatabase
acc.Quit
Set acc = Nothing
End Sub
I am having an issue (otherwise I wouldn't be here) :)
In Excel I have a list of item numbers that need to be checked if they already exist in a database. At the moment the only way to do that is to run a query in a separate sheet to get all the item numbers (400,000+) which takes quite some time and has to be done each time.
I have started a vba query which goes through each cell that is selected and checks that value to see if it exist in the database. If it exist, the cell turns Red. If it doesn't exist, the cell turns green.
I'm not that great when it comes to querying databases using VBA so I used bits and pieces that I found online.
When I go to test it, Excel crashes and closes so I can't determine where its going wrong.
Public Sub CheckItemNoExist()
Dim DB As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim c As Range
Dim ItemNum As Variant
Dim bFound As Boolean
DB.Open "DSN=DBNAME;UID=****;PWD=****;"
Set rs = DB.OpenRecordset("SELECT [Inventory.ITM_NO] FROM [OAUSER.Inventory] WHERE [Inventory.ITM_NO]=" & ItemNum & ";", dbOpenDynaset)
For Each c In ActiveSheet.Selection
ItemNum = c.Value
bFound = Not rs.EOF
If bFound Then
c.Interior.Color = RGB(255, 0, 0)
Else
c.Interior.Color = RGB(0, 255, 0)
End If
Next
rs.Close
Set rs = Nothing
DB.Close
Set DB = Nothing
End Sub
Thank you!
Matt
I suggest you use an IN in your where clause to bring over all the items in the selection, then filter the recordset for each item to see if it found it. I don't have your data setup, so I used a truck database that I have handy. You should be able to convert
Sub CheckTruckExists()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sSql As String
Dim aInClause() As String
Dim rCell As Range
Dim vaTrucks As Variant
Dim i As Long
'Open a connection to the database
Set cn = New ADODB.Connection
cn.Open sCONNECTIONSTRING
'Get an array of values from the selection
vaTrucks = Selection.Value
'Increase the size of the one-dimensional array to match
ReDim aInClause(LBound(vaTrucks, 1) To UBound(vaTrucks, 1))
'Fill a one-dim array from the two-dim array so we can Join it
For i = LBound(vaTrucks, 1) To UBound(vaTrucks, 1)
aInClause(i) = vaTrucks(i, 1)
Next i
'Build the SQL statement and execute it
sSql = "SELECT ReportTruck FROM qryTrucks WHERE ReportTruck IN ('" & Join(aInClause, "','") & "')"
Set rs = New Recordset
Set rs = cn.Execute(sSql)
'Loop through the selected cells
For Each rCell In Selection.Cells
'clear the filter, then refilter the recordset on the filtered value
rs.Filter = adFilterNone
rs.Filter = "ReportTruck = '" & rCell.Value & "'"
'If the filter returned zero records, it's eof
If rs.EOF Then
rCell.Interior.Color = RGB(255, 0, 0)
Else
rCell.Interior.Color = RGB(0, 255, 0)
End If
Next rCell
End Sub
My ReportTruck field is a String, so I have to enclose all the trucks in my IN clause with single quotes. If you're looking for something other than a String, modify the Join to accommodate that data type.
Also, there's no error checking to makes sure the Selection is actually a Range object or that it contains more than one cell - both are necessary to avoid an error.
I have a range I'd like to arbitrarily sort and filter using vba. I don't, however, want it to affect the worksheet. I'd like to essentially copy the range into some native class that supports filtering and sorting (so i don't have to reinvent the wheel) and use that class to return a result to calling code.
Are there any classes I can use to this end? ListObject looked the most promising but it appears to require being tied to a worksheet range to work properly.
You can use recordsets. Here are some notes:
'Reference: Microsost ActiveX n.n Object Library '
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
'From: http://support.microsoft.com/kb/246335 '
strFile = Workbooks(1).FullName
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
'Must have client-side cursor for sorting '
rs.CursorLocation = adUseClient
'Substitute a name range for [Sheet1$] '
'or include a range of cells : [Sheet1&A1:C7] '
strSQL = "SELECT * FROM [Sheet1$] " _
& "WHERE TransID>2 ORDER BY MyTime"
rs.Open strSQL, cn, 3, 3
rs.Filter = "TransID=3"
rs.Sort = "Mytime"
'Write out to another sheet '
Worksheets(2).Cells(2, 1).CopyFromRecordset rs
You may find this thread interesting: syncing two lists with VBA
If you'd like to read and parse complex sets of data you can use the Microsoft ActiveX Data Objects Recordset 2.8 Library. With this you can read your data into a recordset, then filter, sort, append, delete and pass it to other functions.
I regularly use this, because i often have to manipulate and display large datasets. If it's in a recordset i can use the same manipulation and presentation routines over and over again.
See Merge Excel Sheets.... for an example of throwing data into a recordset. After you have the data in a recordset then use r.filter = "ColumnA = 1", or r.sort = "ColumnC, ColumnA".
Turns out I can create a recordSet to do this. Unlike, Remou's answer though we don't have to invoke a heavy weight odbc process on our sheet.
The following function (adapted from Mark Nold's answer) will create a record set from the supplied range. It assumes column headers are in the first row of the supplied range. This can be made more robust but its a good starting spot
Function CreateRecordSet(rSource As range) As Recordset
' Constants
Const MAX_CHARS = 1200
' Declarations
Dim rs As Recordset
Dim c As Long
Dim r As Long
Dim colCount As Long
Dim rowCount As Long
Dim fldName As String
colCount = rSource.Columns.Count
rowCount = rSource.rows.Count
' Setup record set
Set rs = New Recordset
r = 1 ' assume first row contains headers
For c = 1 To colCount
fldName = rSource.Cells(r, c).Value
rs.Fields.Append fldName, adVarChar, MAX_CHARS
Next c
' Fill record set
rs.Open
r = 2 ' skip header row
For r = 2 To rowCount
rs.AddNew
Debug.Print "row "; r & " of " & rowCount & " created"
For c = 1 To colCount
rs.Fields(c - 1) = CStr(rSource.Cells(r, c).Value)
Debug.Print "-- row(" & r; "): added col " & c & " of " & colCount
Next c
Next r
Set CreateRecordSet = rs
End Function
Sub TestCreateRecordSet()
Dim r As range
Dim rs As Recordset
Set r = range("A1:B4")
Set rs = CreateRecordSet(r)
End Sub
You want to use a Range class (just like CasperOne says). Here's some example VBA code
Function SortAndFilter(rSource As Range) As Range
Dim rResult As Range
Dim vaTemp As Variant
Dim wsTemp As Worksheet
Dim wbTemp As Workbook
vaTemp = rSource.Value
Set wbTemp = Workbooks.Add
Set wsTemp = wbTemp.Sheets(1)
Set rResult = wsTemp.Range("A1").Resize(UBound(vaTemp, 1), UBound(vaTemp, 2))
rResult.Value = vaTemp
rResult.Sort rResult.Cells(1), xlDescending
Set SortAndFilter = rResult
End Function
Sub Testit()
Dim rTest As Range
Set rTest = SortAndFilter(Selection)
'Do stuff with your range object
rTest.Parent.Parent.Close False 'close temp workbook
End Sub
Why not copy the data to a new, hidden worksheet, perform your sort/filter there, and then copy the data back when done?