INSERT INTO query in VBA - sql

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

Related

How to export message box display data in excel to access database table using vba

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.

Excel table to Access query connection, [Microsoft][ODBC Microsoft Access Drive] too few parameters. expected 1

I'm trying to create a table in Excel, which takes data from Access Query. I'm unable to find this query listed under Data->From Access. I'm using Data->From Other Sources -> From Data connection Wizard -> ODBC DSN. On final step it throws error [Microsoft][ODBC Microsoft Access Drive] too few parameters. expected 1.
I will not post full query at this moment, it is long
I will post subquery part (with some formatting) , that already throws this error. Can someone take a look and pinpoint where is the problem.
All queries I have work properly in Access. But I need the results export to Excel, as whole reporting VBA tool is there. (I know I can make SELECT INTO and create table, but it is not as elegant and simple to update) Thank you all for your time. Have a nice day
SELECT
Employees.PersNo,
Employees.Employee_name,
Employees.Reporting_Month,
Employees.Gender_Key,
Employees.Start_Date,
Employees.Business_Unit,
Employees.Position_ID,
Employees.Position,
Employees.Local_Band,
Employees.PS_Group,
Employees.Wage_Amount,
val(Employees.Bonus) AS [Bonus_%],
val([Employees].[Commissions_(%)]) AS [Commisions_%],
Employees.Wage_type, Employees.Wkhrs,
Q1.Business_Unit,
Q1.Position_ID,
Q1.Position,
Q1.Local_Band,
Q1.PS_Group,
Q1.Wage_Amount,
[Q1].[Bonus_%],
[Q1].[Commisions_%],
Employees.Wage_type,
Employees.Wkhrs,
Employees.Evid_Status
FROM Employees LEFT JOIN (SELECT
Dateadd("m",1,[Employees.Reporting_Month]) AS Reporting_Month,
Employees.PersNo,
Employees.Local_Band,
Employees.PS_Group,
Employees.Wage_Amount,
val(Employees.Bonus) AS [Bonus_%],
val([Employees].[Commissions_(%)]) AS [Commisions_%],
Employees.Wage_type, Employees.Wkhrs,
Employees.Business_Unit,
Employees.Position_ID,
Employees.Position,
Employees.Evid_Status
FROM Employees WHERE Employees.Evid_Status=1 ) AS Q1
ON (Employees.Reporting_Month = [Q1].[Reporting_Month]) AND (Employees.PersNo = [Q1].[PersNo])
WHERE Employees.Evid_Status=1;
Because Position is a reserved word in MS Accces, simply escape the word in both outer query and subquery with backticks or square brackets.
Interestingly, while the table alias qualifier works for reserved words inside the MSAccess.exe GUI program, external ODBC calls like from Excel may fail without escaping such reserved words:
SELECT
...
Employees.[Position],
...
SELECT
...
Employees.`Position`,
...
You can use Excel to query Access, like you see in the link below.
http://translate.google.pl/translate?js=n&prev=_t&hl=pl&ie=UTF-8&layout=2&eotf=1&sl=pl&tl=en&u=http%3A%2F%2Fafin.net%2FKsiazkaSQLwExcelu%2FGraficznyEdytorZapytanSqlNaPrzykladzieMsQuery.htm
Also, consider using a parameter query to do the export from Access to Excel.
Dim dbs As DAO.Database
Dim qdfTemp As DAO.QueryDef
Dim strSQL As String, strQDF As String
Set dbs = CurrentDb
' Replace NameOfTableOrQuery with the real name of the table or query,
' replace NameOfForm with the real name of the form, and replace
' ADateControlOnForm and AnotherDateControlOnForm with the real names
' of the controls on that form
strSQL = "SELECT NameOfTableOrQuery.* FROM NameOfTableOrQuery " & _
"WHERE NameOfTableOrQuery.FieldName >= " & _
Format(Forms!NameOfForm!ADateControlOnForm.Value,"\#mm\/dd\/yyyy\#") & _
" And NameOfTableOrQuery.FieldName <=" & _
Format(Forms!NameOfForm!AnotherDateControlOnForm.Value,"\#mm\/dd\/yyyy\#") & "';"
strQDF = "_TempQuery_"
Set qdfTemp = dbs.CreateQueryDef(strQDF, strSQL)
qdfTemp.Close
Set qdfTemp = Nothing
' Replace C:\MyFolderName\MyFileName.xls with the real path and filename for the
' EXCEL file that is to contain the exported data
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strQDF,"C:\MyFolderName\MyFileName.xls"
dbs.QueryDefs.Delete strQDF
dbs.Close
Set dbs = Nothing
Or...write data from a record set in Access to Excel.
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim blnEXCEL As Boolean, blnHeaderRow As Boolean
blnEXCEL = False
' Replace True with False if you do not want the first row of
' the worksheet to be a header row (the names of the fields
' from the recordset)
blnHeaderRow = True
' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlx = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
' Change True to False if you do not want the workbook to be
' visible when the code is running
xlx.Visible = True
' Replace C:\Filename.xls with the actual path and filename
' of the EXCEL file into which you will write the data
Set xlw = xlx.Workbooks.Open("C:\Filename.xls")
' Replace WorksheetName with the actual name of the worksheet
' in the EXCEL file
' (note that the worksheet must already be in the EXCEL file)
Set xls = xlw.Worksheets("WorksheetName")
' Replace A1 with the cell reference into which the first data value
' is to be written
Set xlc = xls.Range("A1") ' this is the first cell into which data go
Set dbs = CurrentDb()
' Replace QueryOrTableName with the real name of the table or query
' whose data are to be written into the worksheet
Set rst = dbs.OpenRecordset("QueryOrTableName", dbOpenDynaset, dbReadOnly)
If rst.EOF = False And rst.BOF = False Then
rst.MoveFirst
If blnHeaderRow = True Then
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
Next lngColumn
Set xlc = xlc.Offset(1,0)
End If
' write data to worksheet
Do While rst.EOF = False
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1,0)
Loop
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
' Close the EXCEL file while saving the file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
xlw.Close True ' close the EXCEL file and save the new data
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing
Or, simply import the data from Access to Excel.
Sub ADOImportFromAccessTable(DBFullName As String, _
TableName As String, TargetRange As Range)
' Example: ADOImportFromAccessTable "C:\FolderName\DataBaseName.mdb", _
"TableName", Range("C1")
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
Set TargetRange = TargetRange.Cells(1, 1)
' open the database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
DBFullName & ";"
Set rs = New ADODB.Recordset
With rs
' open the recordset
.Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable
' all records
'.Open "SELECT * FROM " & TableName & _
" WHERE [FieldName] = 'MyCriteria'", cn, , , adCmdText
' filter records
RS2WS rs, TargetRange ' write data from the recordset to the worksheet
' ' optional approach for Excel 2000 or later (RS2WS is not necessary)
' For intColIndex = 0 To rs.Fields.Count - 1 ' the field names
' TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
' Next
' TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Having the same error - linking Excel and Access.
After changing double quotes to single quotes the error "too few parameters. expected 1" was resolved. The sample of correct code.
AND all_clean.lastapp='Dial'

Run through a loop for more than 100,000 rows of data in two sheets in the same workbook

I currently have code to allow me to look through the rows with matching ID from Sheet 1 and Sheet 2. When both IDs match, Sheet 2 information will be pasted to the Sheet 1 rows with the same IDs. My code works on less than 1,000 rows and when I tested it gave results within a minute.
The problem is that when I tried to run it for 1,000,000 rows it keeps running and for more than 20 minutes and never stop running since then. I hope anyone could assist me in making changes to the code to allow me to do a loop and copy paste the information from Sheet 2 to Sheet 1 for 200,000 rows.
Sub Sample()
Dim tracker As Worksheet
Dim master As Worksheet
Dim cell As Range
Dim cellFound As Range
Dim OutPut As Long
Set tracker = Workbooks("test.xlsm").Sheets("Sheet1")
Set master = Workbooks("test.xlsm").Sheets("Sheet2")
Application.ScreenUpdating = False
For Each cell In master.Range("A2:A200000")
Set cellFound = tracker.Range("A5:A43000").Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not cellFound Is Nothing Then
matching value
cellFound.Offset(ColumnOffset:=1).Value2 = cell.Offset(ColumnOffset:=2).Value2
Else
End If
Set cellFound = Nothing
Debug.Print cell.Address
Next
Application.ScreenUpdating = True
OutPut = MsgBox("Update over!", vbOKOnly, "Update Status")
End Sub
Above is the code that I have for now.
Incorporating #paulbica's suggestion, this ran in several seconds for me.
Sub Sample()
Dim rngTracker As Range
Dim rngMaster As Range
Dim arrT, arrM
Dim dict As Object, r As Long, tmp
With Workbooks("test.xlsm")
Set rngTracker = .Sheets("Tracker").Range("A2:B43000")
Set rngMaster = .Sheets("Master").Range("A2:C200000")
End With
'get values in arrays
arrT = rngTracker.Value
arrM = rngMaster.Value
'load the dictionary
Set dict = CreateObject("scripting.dictionary")
For r = 1 To UBound(arrT, 1)
dict(arrT(r, 1)) = r
Next r
'map between the two arrays using the dictionary
For r = 1 To UBound(arrM, 1)
tmp = arrM(r, 1)
If dict.exists(tmp) Then
arrT(dict(tmp), 2) = arrM(r, 3)
End If
Next r
rngTracker.Value = arrT
End Sub
You could use the index of a Dictionary object and use its native indexing properties to perform the lokups. I'm not sure just how well that will perform in a data set of 200K records where a high report of failure was going to occur and you are showing at least a 78% failure rate (200K records to match and update 43K records).
Sub Sample3()
Dim tracker As Worksheet, master As Worksheet
Dim OutPut As Long
Dim v As Long, p As Long, vMASTER As Variant, vTRACKER As Variant, dMASTER As Object
Set tracker = Workbooks("test.xlsm").Sheets("Sheet1")
Set master = Workbooks("test.xlsm").Sheets("Sheet2")
Set dMASTER = CreateObject("Scripting.Dictionary")
Debug.Print Timer
'Application.ScreenUpdating = False '<~~no real need to do this if working in memory
With tracker
vTRACKER = .Range(.Cells(5, 2), .Cells(Rows.Count, 1).End(xlUp)).Value2
End With
With master
vMASTER = .Range(.Cells(2, 1), .Cells(Rows.Count, 3).End(xlUp)).Value2
For v = LBound(vMASTER, 1) To UBound(vMASTER, 1)
If Not dMASTER.exists(vMASTER(v, 1)) Then _
dMASTER.Add Key:=vMASTER(v, 1), Item:=vMASTER(v, 3)
Next v
End With
For v = LBound(vTRACKER, 1) To UBound(vTRACKER, 1)
If dMASTER.exists(vTRACKER(v, 1)) Then _
vTRACKER(v, 2) = dMASTER.Item(vTRACKER(v, 1))
Next v
With ThisWorkbook.Sheets("Sheet1") 'tracker
.Cells(5, 1).Resize(UBound(vTRACKER, 1), 2) = vTRACKER
End With
'Application.ScreenUpdating = True '<~~no real need to do this if working in memory
Debug.Print Timer
OutPut = MsgBox("Update over!", vbOKOnly, "Update Status")
dMASTER.RemoveAll: Set dMASTER = Nothing
Set tracker = Nothing
Set master = Nothing
End Sub
Once both ranges are mirrored into variant arrays, a dictionary is created in order to fully utilize its indexing properties for identification.
The above shows about a significant increase in efficiency over 200K records in master vs 43K records in tracker.
btw, I did use an .XLSB for this; not an .XLSM.
It might also be faster to use ADODB.
Dim filepath As String
Dim conn As New ADODB.Connection
Dim sql As String
filepath = "c:\path\to\excel\file\book.xlsx"
With conn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=""" & filepath & """;" & _
"Extended Properties=""Excel 12.0;HDR=No"""
sql = _
"UPDATE [Sheet1$A2:B200000] AS master " & _
"INNER JOIN [Sheet2$] AS tracker ON master.F1 = tracker.F1 " & _
"SET master.F2 = tracker.F2"
.Execute sql
End With
This works with Office 2007. Office 2010 (I haven't tested on 2013) has a security measure that prevents updating Excel spreadsheets with an SQL statement. In this case you can either use the old Jet provider, which doesn't have this security measure. This provider doesn't support .xlsx, .xlsm or .xlsb files; only .xls.
With conn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=""" & filepath & """;" & _
"Extended Properties=""Excel 8.0;HDR=No"""
Alternatively, you can read the resulting data into a disconnected recordset and paste the recordset into the original worksheet:
Dim filepath As String
Dim conn As New ADODB.Connection
Dim sql As String
Dim rs As New ADODB.Recordset
filepath = "c:\path\to\excel\file\book.xlsx"
With conn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=""" & filepath & """;" & _
"Extended Properties=""Excel 12.0;HDR=No"""
sql = _
"SELECT master.F1, IIF(tracker.F1 Is Not Null, tracker.F2, master.F2) " & _
"FROM [Sheet1$A2:B200000] AS master " & _
"LEFT JOIN [Sheet2$] AS tracker ON master.F1 = tracker.F1 "
rs.CursorLocation = adUseClient
rs.Open sql, conn, adOpenForwardOnly, adLockReadOnly
conn.Close
End With
Workbooks.Open(filepath).Sheets("Sheet1").Cells(2, 1).CopyFromRecordset rs
If using CopyFromRecordset, keep in mind that there is no guarantee of the order in which the records are returned, which might be a problem if there is other data in the master worksheet besides columns A and B. To resolve this, you can include those other columns in the recordset as well. Alternatively, you can enforce the order of the records using an ORDER BY clause, and sort the data in the worksheet before you begin.

Pulling Column Names into Excel from SQL query

I'm using Excel to pull data from an SQL db. I used the code from another SO question and it works fine. Now I want to pull in the column names from a table in addition to the actual table. I figured out that I could get the names using the For Each fld loop. However there's still the issue of populating them horizontally in a row in Excel as the number of columns might change - so I'm thinking I would need another For each loop also or something similar.
Sub GetDataFromADO()
'Declare variables'
Set objMyConn = New ADODB.Connection
Set objMyCmd = New ADODB.Command
Set objMyRecordset = New ADODB.Recordset
'Open Connection'
objMyConn.ConnectionString = "Provider=SQLOLEDB;Data Source=localhost;User ID=abc;Password=abc;"
objMyConn.Open
'Set and Excecute SQL Command'
Set objMyCmd.ActiveConnection = objMyConn
objMyCmd.CommandText = "select * from myTable"
objMyCmd.CommandType = adCmdText
objMyCmd.Execute
'Loop Names'
' WHAT TO DO HERE????'
'Open Recordset'
Set objMyRecordset.ActiveConnection = objMyConn
objMyRecordset.Open objMyCmd
'Copy Data to Excel'
ActiveSheet.Range("A1").CopyFromRecordset (objMyRecordset)
End Sub
My usual code is very similar:
For intColIndex = 0 To objMyRecordset.Fields.Count - 1
Range("A4").Offset(0, intColIndex).Value = objMyRecordset.Fields(intColIndex).Name
Next
Ok so I figured it out after 4 attempts, here's the code for the loop.
'Loop'
Dim FieldRange As Range
Set FieldRange = Range("A4")
Set TableColumns = Range("A4:H4")
x = 1
Range("A4").Select
For Each fld in objMyRecordset.Fields
ActiveCell.Value = fld.Name
ActiveCell.Offset(0, x).Select
x = x + 1 'tick iterator
Next
ActiveSheet.Range("A5").CopyFromRecordset objMyRecordset
Range("A4").Select
To make it super simple, do something like this (using Sheet1 and recordset r)
For i = 0 To r.Fields.Count - 1
Sheet1.Cells(1, i + 1) = r.Fields(i).Name
Next i
You can just set your "x" variable to 0 and then do something like:
x = 0
For Each Field In RS.Fields 'RS being my Recordset variable
Range("A3").Offset(0, x).Value = Field.Name
x = x + 1
Next Field
And that will make it a bit easier to read... :)

Is there a native excel class which allows a range to be copied and sorts/filters applied?

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?