Dave said:
I have a co-worker who wants to be able to do a query within a worksheet - it
should be ridiculosly easy, but I can't seem to figure it out, and Excel
2003's help only speaks of importing queried data into Excel, and that's not
what I want.
It not a good idea to query an open workbook. The usual workaround is
to copy of relevant sheets to a new/blank workbook, close and query
the (closed) copy. Here's some code I made earlier:
Option Explicit
Sub test()
CopyToNewWorksheet "Sheet1", "MyNewSheet"
End Sub
Private Function CopyToNewWorksheet( _
ByVal SheetName As String, _
Optional ByVal NewSheetName As String _
) As Boolean
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim Target As Excel.Range
Dim Con As Object
Dim rs As Object
Dim strCon As String
Dim strPath As String
Dim strSql1 As String
Dim lngCounter As Long
' Review the following constant:
Const FILENAME_XL_TEMP As String = "" & _
"delete_me.xls"
Const TABLE_XL_TEMP As String = "" & _
"test_only"
' Do NOT amend the following constants
Const CONN_STRING As String = "" & _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=<PATH><FILENAME>;" & _
"Extended Properties='Excel 8.0;HDR=YES'"
Const SQL As String = "" & _
"SELECT * FROM [<SHEET_NAME>$]"
' Build connection string
strPath = ThisWorkbook.Path & _
Application.PathSeparator
strCon = CONN_STRING
strCon = Replace(strCon, _
"<PATH>", strPath)
strCon = Replace(strCon, _
"<FILENAME>", FILENAME_XL_TEMP)
' Build sql statement
strSql1 = SQL
strSql1 = Replace(strSql1, _
"<SHEET_NAME>", TABLE_XL_TEMP)
' Delete old instance of temp workbook
On Error Resume Next
Kill strPath & FILENAME_XL_TEMP
On Error GoTo 0
' Save copy of worksheet to temp workbook
Set wb = Excel.Application.Workbooks.Add()
With wb
ThisWorkbook.Worksheets(SheetName). _
Copy .Worksheets(1)
.Worksheets(1).Name = TABLE_XL_TEMP
.SaveAs strPath & FILENAME_XL_TEMP
.Close
End With
' Open connection to temp workbook
Set Con = CreateObject("ADODB.Connection")
With Con
.ConnectionString = strCon
.Open
Set rs = .Execute(strSql1)
End With
Set ws = ThisWorkbook.Worksheets.Add
With ws
If Len(NewSheetName) > 0 Then
.Name = NewSheetName
End If
Set Target = .Range("A1")
End With
With rs
For lngCounter = 1 To .fields.Count
Target(1, lngCounter).Value = _
.fields(lngCounter - 1).Name
Next
End With
Target(2, 1).CopyFromRecordset rs
Con.Close
CopyToNewWorksheet = True
End Function
Jamie.
--
