I am trying to create a Vlookup using VBA in Excel.
I want to look up 'column1' on 'Sheet1' against 'column2' on 'Sheet2'
I also want to return multiple columns on Sheet 1 - 3,4,5,6 (from Sheet2)
Can you help me with this?
I think it would be easier and much faster to use sql query table, instead of vlookup.
Below I present code with two macros:
1) First call second macro that makes query table you want.
2) Second is a subprocerude that executes indicated ado sql query statement (indicated in sql_stmt string) and pastes it to indicated sheet and range.
In sql_stmt string definiton you must change "sheetX_columnXheader" to adequate columns headers.
If you want to get results in different sheet you need to call sql_query subprocedure with different second parameter.
If you want to get other columns as a result or match data on different columns you must change sql_stmt string to adequate ado sql query statement.
Option Explicit
Sub matching_data()
Dim sqlstmt As String
On Error GoTo error
Application.ScreenUpdating = False
sqlstmt = "SELECT a.[sheet1_column1header], b.[sheet2_column2header], b.[sheet2_column3header], b.[sheet4_column2header] FROM [sheet1$] a LEFT JOIN [sheet2$] b ON a.[sheet1_column1header]=b.[sheet2_column1header]"
sql_query sqlstmt, "new_sheet", "A1"
'ending
Application.ScreenUpdating = True
MsgBox ("Finished")
Exit Sub
'error message
error:
MsgBox ("Unknown error")
Application.ScreenUpdating = True
End Sub
'subprocedure that executes ado sql query statement and pastes results in indicated range and sheet
Public Sub sql_query(ByVal sqlstmt As String, ByVal sheet_name As String, ByVal target1 As String)
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim connstring As String
Dim qt As QueryTable
Dim tw_path As String
Dim is_name As Boolean
Dim sh As Worksheet
On Error GoTo error
'''adding sheet if there is no sheet with indicated name
is_name = False
For Each sh In ThisWorkbook.Worksheets
If sh.Name = sheet_name Then is_name = True
Next
If is_name = False Then ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)).Name = sheet_name
''' connection
tw_path = ThisWorkbook.path & "\" & ThisWorkbook.Name
connstring = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & tw_path & ";Extended Properties=Excel 8.0;Persist Security Info=False"
''' making database
Set conn = New ADODB.Connection
conn.ConnectionString = connstring
conn.Open
'''executing statement
Set rs = New ADODB.Recordset
rs.Source = sqlstmt
rs.ActiveConnection = conn
rs.Open
'''saving results
ThisWorkbook.Worksheets(sheet_name).Activate
Set qt = Worksheets(sheet_name).QueryTables.Add(Connection:=rs, Destination:=Range(target1))
qt.Refresh
'''ending
ending:
If rs.State <> adStateClosed Then rs.Close
conn.Close
If Not rs Is Nothing Then Set rs = Nothing
If Not conn Is Nothing Then Set conn = Nothing
Set qt = Nothing
Exit Sub
'
error:
MsgBox ("Unknown error occured in sql query subprocedure")
GoTo ending
End Sub
Remember to activate "Microsoft ActiveX data object 2.8 library" or higher in VBA editor (tools -> references...).
Keep in mind, that maximum size for data in each sheet is 256 columns and 65535 rows.
Works with Excel 2007.
Hope, this will help.
Related
I am struggling to find relevant information on the
'run-time error '-2147418113 (8000ffff)' - Catastrophic Failure'
I am experiencing.
Sub GenerateAIA_Click()
Dim SQL_query, SQL_syntax, DB_path, setting_conn As String
Dim conn As New ADODB.Connection
Dim query_rslt As New ADODB.Recordset
Dim mth, mth_yr As Variant
Dim dt As Date
Dim i, bol As Integer
Dim temp1, temp2 As Variant
dt = Sheets("Main").Range("C4")
mth_yr = MonthName(Month(Sheets("Main").Range("I12")), False) & " " & Year(Sheets("Main").Range("I12"))
ThisWorkbook.Sheets("AIA").Select
DB_path = ThisWorkbook.FullName 'Refering the same workbook as Data Source
setting_conn = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DB_path & ";HDR=Yes';"
conn.Open setting_conn
SQL_syntax = "SELECT * FROM [Setup$]" 'Your SQL Statement (Table Name= Sheet Name=[Sheet1$])
query_rslt.Open SQL_syntax, conn
I have also noticed that this error is shown on the line
conn.Open setting_conn
I use excel 2016 and also my file format .xlsm
Anyone have idea why is this happening?
It seems your connection string has a problem.
Here's how I got it to work:
(First make sure to add a reference to the Microsoft Active-X Data Objects Library)
Sub test()
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\PC\test.xlsm;Extended Properties=""Excel 12.0 Macro;HDR=NO"";"
conn.Open
rs.Open "SELECT * FROM [Sheet1$]", conn
If Not rs.EOF Then
MsgBox rs(0) ' display the value of the first field in the first row
Else
MsgBox "No records found."
End If
rs.Close
conn.Close
End Sub
So take my example, change the filename to your XLSM file, and the sheet name to your sheet name (with a $ added to the end of it)
If your sheet has header names in the first now, use HDR=Yes, and if not, HDR=No
or you can change display resolution for your monitor
I am facing an issue while exporting my Microsoft access data to an excel file.
It is giving me an error message of:
You selected more records than can be copied onto the Clipboard at one time. Divide the records into two or more groups, and then copy and paste one group at a time. The maximum number of records you can paste at one time is approximately 65,000.
The code that i am using:
FileCopy "S:\Users\File\Deposit.xls", strs & "\Deposit.xls"
Try this:
Select External data
Got to Export
Hit Excel
You will be given a choice to select the destination for your data
Select where you want to save your exported data
In the Specify Report Options Area- you have the option to select and tick Export Data With Formatting And Layout
You also have the option to open the destination file after the export operation is complete- tick if you want to utilise this option
Hit OK
You may now get the above error at this stage if you have ticked the Export Data With Formatting And Layout Option and are trying to export more than 65,000 data lines
When the data is exported you can then hit Close
Using VBA:
Sub transSpread()
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
"tblSales", "C:\Sales.xls"
MsgBox "Sales spreadsheet created"
End Sub
Or:
Option Compare Database
Option Explicit
' be sure to select Microsoft Excel Object Library in the References dialog box
Public myExcel As Excel.Application
Sub CopyToExcel()
Dim conn As ADODB.Connection
Dim myRecordset As ADODB.Recordset
Dim wbk As Excel.Workbook
Dim myWorksheet As Excel.Worksheet
Dim StartRange As Excel.Range
Dim strConn As String
Dim i As Integer
Dim f As Variant
On Error GoTo ErrorHandler
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\mydb.mdb"
Set conn = New ADODB.Connection
Set myRecordset = New ADODB.Recordset
With myRecordset
.Open "Employees", strConn, _
adOpenKeyset, adLockOptimistic
End With
Set myExcel = New Excel.Application
Set wbk = myExcel.Workbooks.Add
Set myWorksheet = wbk.ActiveSheet
myExcel.Visible = True
i = 1
With myRecordset
For Each f In .Fields
With myWorksheet
.Cells(1, i).Value = f.Name
i = i + 1
End With
Next
End With
Set StartRange = myWorksheet.Cells(2, 1)
StartRange.CopyFromrecordset myRecordset
myRecordset.Close
Set myRecordset = Nothing
myWorksheet.Columns.AutoFit
wbk.Close SaveChanges:=True, _
FileName:="C:\ExcelFile.xls"
myExcel.Quit
Set conn = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbCritical, _
"Automation Error"
Set myExcel = Nothing
Exit Sub
End Sub
I would like to get the cell value from other workbooks to my master file.
Those files are in the same folder G:\Data\xxx\yyy while the file name is customer ID.
I.e. the file path could be G:\Data\xxx\yyy\123 or G:\Data\xxx\yyy\234
And the value I would like to extract from those workbooks is in Sheet ABC cell J55.
So the formula I input in the cell is = G:\Data\xxx\yyy [123.xlsm]'!$J$55
In the master file, I have a list of customer ID in Column A and I would like to get the value from cell J55 in other workbooks. i.e. create a dynamic file path to get the numbers and paste it to column B.
However, I tried to combine the link with the “CONCATENATE” and “G” but didn’t work out.
I tried the indirect function but it requires me to open the referencing workbooks that is not ideal.
Is that a way for me to get the numbers?
VBA coding is welcome.
This is a solution that can be run from Excel VBA. I admit it might be overkill to solving your issue but it will check column A for values and fill column B if it is blank from J55 of the selected workbooks without opening any of them.
It assumes you have Microsoft Access as part of your office suite, are running on a 64 bit version of Windows, the files your are retrieving data from have a .xlsx extension and the data you want from J55 is on "Sheet1". If any of these assumptions are incorrect please let me know as the code can be easily adjust to accommodate.
From the information you have provided it seems that the file path for all the files you would like to access are static (G:\Data\xxx\yyy) and only the file name is dynamic (file name = Customer ID # from column A). You will need to make a reference to Microsoft XML v6.0 and Microsoft ActiveX Data Objects x.x Library.
The code below is mostly cut and pasted from another project I wrote. It does still need to be tested. I would advise adding some error handling and the normal performance enhancing vba code like turning off screen updating.
Option Explicit
Public Sub Test()
'Folder where Wb live
Const FilePath As String = "G:\Data\xxx\yyy\"
'Command string
Const request_SQL As String = "SELECT * FROM [Sheet1$]"
'Get last row
Dim LastRow As Long
With ActiveWorkbook.ActiveSheet
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
'Create Array from Main worksheet
Dim MainWsArray As Variant
MainWsArray = ActiveWorkbook.ActiveSheet.Range(Cells(1, 1), Cells(LastRow, 2))
Dim FullFileName As String
'Create a connection to be used throughout the loop
Dim Cnx As ADODB.Connection
Set Cnx = New ADODB.Connection
Dim CustomerId As Long
Dim RowCounter As Long
Dim Rst As ADODB.Recordset
Set Rst = New ADODB.Recordset
'Loop through Array to get values
For RowCounter = 1 To LastRow
If MainWsArray(2, RowCounter) = vbNullString Then
CustomerId = MainWsArray(1, RowCounter).Value
FullFileName = FilePath & CustomerId
AssignCnx Cnx, FullFileName
'Create RecordSet
If OpenRecordset(Rst, request_SQL, Cnx) Then
MsgBox "Unable to open Recordset. " & CustomerId
End If
'Use recordset to get data from file.
Rst.Move 54
MainWsArray(2, RowCounter) = Rst.Fields(10)
End If
Rst.Close
Cnx.Close
Next RowCounter
ActiveWorkbook.ActiveSheet.Range(Cells(1, 2), Cells(LastRow, 2)) = MainWsArray()
If Not Rst Is Nothing Then Set Rst = Nothing
If Not Cnx Is Nothing Then Set Cnx = Nothing
End Sub
Public Sub AssignCnx(ByRef Cnx As ADODB.Connection, ByVal FullFileName As String)
'Connection
With Cnx
.Provider = "Microsoft.ACE.OLEDB.12.0" 'or "Microsoft.Jet.OLEDB.4.0" for 32bit
.ConnectionString = "Data Source=" & FullFileName & _
";Extended Properties='Excel 12.0 xml;HDR=NO;IMEX=1;Readonly=False'"
.Open
End With
End Sub
Private Function OpenRecordset(ByRef Rst As ADODB.Recordset, ByVal request_SQL As String, ByRef Cnx As ADODB.Connection) As Boolean
'Error Trapping for the RecordSet
Dim backupRequestString As String
On Error Resume Next
Rst.Open request_SQL, Cnx, adOpenForwardOnly, adLockReadOnly, adCmdText
If Err.Number = 0 Then
OpenRecordset = False
Exit Function
Else
Rst.Close
OpenRecordset = True
Exit Function
End If
End Function
I hope you find this helpful. If it is a bit much there are other ways to link workbooks to the master file from within Excel w/o VBA. It's been a long time since I have done it that way though. Best of luck.
My below code shows no error, when run, but I don't know how to extract required/particular field values into my excel sheet.
Sub getdatafromaccesstoanarray()
Dim cn As Object 'Connection
Dim rs As Object 'Recordset
Dim vAry() As Variant 'Variant Array
Dim dbPath As String 'Database Path
Dim dbName As String 'Database Name
Dim txt As String
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
dbPath = ThisWorkbook.Path & "\"
dbName = "NewDB.accdb"
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & dbPath & dbName & ";"
rs.Open "SELECT * FROM BILLDETAILS WHERE BILLDETAILS.SN_AUTO =100;", cn
vAry = rs.GetRows()
'now when the data is copied to my array how can i paste specific values from this data to
'cells in my excel sheet
'like
'on active sheet
'[a1] = vAry(value1)
'[a2] = vAry(value3)
'[a3] = vAry(value8)
'and other values like wise
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub
If there any other way to do this then please let me know.
Thanks!
If you just want to copy the recordset into the sheet you can use the CopyFromRecordset method to dump the table into the sheet by specifying the top left corner:
Range("a1").copyfromrecordset rs
If you want to put specific fields in specific positions you can loop
Do While not rs.eof
range("a2")=rs(0)
range("b2")=rs(1)
'etc....
rs.movenext
Loop
I have a table in an Excel file with some data, and I want to export these data to my database on Access (in a concrete table on my database called Water Quality) with a VBA code to avoid to open my Database every time that I want to introduce more data on it.
At the moment I have this code but it's not working...
Sub Button14_Click()
' Macro purpose: To add record to Access database using ADO and SQL
' NOTE: Reference to Microsoft ActiveX Data Objects Libary required
' Exports data from the active worksheet to a table in an Access database
'Dim cnt As New ADODB.Connection
'Dim rst As New ADODB.Recordset
Dim cnt As DAO.Database
Dim rst As Recordset
Dim dbPath As String
Dim tblName As String
Dim rngColHeads As Range
Dim rngTblRcds As Range
Dim colHead As String
Dim rcdDetail As String
Dim ch As Integer
Dim cl As Integer
Dim notNull As Boolean
Dim sConnect As String
'Set the string to the path of your database as defined on the worksheet
dbPath = "C:\Documents and Settings\Administrador\Mis documentos\MonEAU\modelEAU Database V.2.accdb"
tblName = "Water Quality"
Set rngColHeads = ActiveSheet.Range("tblHeadings")
Set rngTblRcds = ActiveSheet.Range("tblRecords")
'Set the database connection string here
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & dbPath & "';" 'For use with *.accdb files
' sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath & ";" 'For use with *.mdb files
'Concatenate a string with the names of the column headings
colHead = " ("
For ch = 1 To rngColHeads.Count
colHead = colHead & rngColHeads.Columns(ch).Value
Select Case ch
Case Is = rngColHeads.Count
colHead = colHead & ")"
Case Else
colHead = colHead & ","
End Select
Next ch
'Open connection to the database
cnt.Open sConnect
'Begin transaction processing
On Error GoTo EndUpdate
cnt.BeginTrans
'Insert records into database from worksheet table
For cl = 1 To rngTblRcds.Rows.Count
'Assume record is completely Null, and open record string for concatenation
notNull = False
rcdDetail = "('"
'Evaluate field in the record
For ch = 1 To rngColHeads.Count
Select Case rngTblRcds.Rows(cl).Columns(ch).Value
'if empty, append value of null to string
Case Is = Empty
Select Case ch
Case Is = rngColHeads.Count
rcdDetail = Left(rcdDetail, Len(rcdDetail) - 1) & "NULL)"
Case Else
rcdDetail = Left(rcdDetail, Len(rcdDetail) - 1) & "NULL,'"
End Select
'if not empty, set notNull to true, and append value to string
Case Else
notNull = True
Select Case ch
Case Is = rngColHeads.Count
rcdDetail = rcdDetail & rngTblRcds.Rows(cl).Columns(ch).Value & "')"
Case Else
rcdDetail = rcdDetail & rngTblRcds.Rows(cl).Columns(ch).Value & "','"
End Select
End Select
Next ch
'If record consists of only Null values, do not insert it to table, otherwise
'insert the record
Select Case notNull
Case Is = True
rst.Open "INSERT INTO " & tblName & colHead & " VALUES " & rcdDetail, cnt
Case Is = False
'do not insert record
End Select
Next cl
EndUpdate:
'Check if error was encounted
If Err.Number <> 0 Then
'Error encountered. Rollback transaction and inform user
On Error Resume Next
cnt.RollbackTrans
MsgBox "There was an error. Update was not succesful!", vbCritical, "Error!"
Else
On Error Resume Next
cnt.CommitTrans
End If
'Close the ADO objects
cnt.Close
Set rst = Nothing
Set cnt = Nothing
On Error GoTo 0
End Sub
At the moment, the problem is when I debug the code, there appears the compiling error: "Method or data member not found" on the function "cnt.Open sConnect".
If this is possible, any help would be greatly appreciated.
Note: I'm using Office 2010.
Your compile error is due to these 2 lines:
Dim cnt As DAO.Database
cnt.Open sConnect
A DAO.Database object does not have an .Open method, which explains "Method or data member not found". Too often error messages can be somewhat vague and just not very helpful. However, in this case, I can't think how the error message could be any more clear.
There is something more which I don't understand. sConnect looks like an ADO connection string. But cnt is a DAO (database) object. You can't mashup the two object models like that in one statement.
You have this just before your active variable declarations:
'Dim cnt As New ADODB.Connection
Then later in your procedure, you have:
'Close the ADO objects
cnt.Close
So perhaps you originally intended cnt to be an ADO.Connection object and didn't adapt the rest of your code after you switched it to a DAO.Database object.
I suggest you revise your code to sort out the DAO vs. ADO confusion, then show us the new code if you have any remaining problems. And please show us only the minimum tested code required to reproduce the problem you're hoping to solve. TIA for your consideration.
I only have Access databases that open the excel file (instead of the other way around) but from looking through my code I think you should go straight to this:
`Set cnt = OpenDatabase_
(dbPath, False, True, "Access 8.0;")
Found this on http://support.microsoft.com/kb/190195 too.
Does this help?