View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Jamie Collins Jamie Collins is offline
external usenet poster
 
Posts: 593
Default Filtering records

"Ryan RBG" wrote ...

I have a database (in .xls format for now) that consists of 3

columns:

The first and leftmost column is the criteria column, which has 565
different names, all unique. The middle column is my array column from which
i want to search, which has roughly 1488 group names, in which contains all
565 group names in the first column, plus 923 group names i dont want . The
third column i want to keep in line or match with the second column which is
the account # (basically i want columns 2 and 3 to stay together).


Here's a database solution which will help when you move your data to
a 'proper' database product.

If your data as described is in columns A, B and C and have headings
CriteriaCol, KeyCol and dataCol respectively, the following query
should work:

SELECT DT2.KeyCol, DT2.DataCol
FROM
(
SELECT CriteriaCol
FROM [MySheet$A:A]
WHERE CriteriaCol IS NOT NULL
) AS DT1
INNER JOIN
(
SELECT KeyCol, DataCol
FROM [MySheet $B:C]
) AS DT2
ON DT1.CriteriaCol=DT2.KeyCol;

Here's some code to execute the query and put the selected data onto a
new sheet (review the constants in code e.g. sheet name will need to
be amended):

Option Explicit

Sub Test()

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

' Amend the following constants to suit
Const FILENAME_XL_TEMP As String = "" & _
"delete_me.xls"
Const TABLE_NAME_CURRENT As String = "" & _
"XXX"
Const TABLE_NAME_NEW As String = "" & _
"MyNewTable"

' Do NOT amend the following constants
Const CONN_STRING_1 As String = "" & _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=<PATH<FILENAME;" & _
"Extended Properties='Excel 8.0;HDR=YES'"

' Build connection strings
strPath = ThisWorkbook.Path & _
Application.PathSeparator

strCon = CONN_STRING_1
strCon = Replace(strCon, _
"<PATH", strPath)
strCon = Replace(strCon, _
"<FILENAME", FILENAME_XL_TEMP)

' Build sql statement
strSql1 = "" & _
"SELECT DT2.KeyCol, DT2.DataCol FROM (SELECT" & _
" CriteriaCol FROM [" & TABLE_NAME_CURRENT & "$A:A]" & _
" WHERE CriteriaCol IS NOT NULL) AS DT1" & _
" INNER JOIN (SELECT KeyCol, DataCol FROM" & _
" [" & TABLE_NAME_CURRENT & "$B:C]) AS DT2" & _
" ON DT1.CriteriaCol=DT2.KeyCol;"
' 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(TABLE_NAME_CURRENT). _
Copy .Worksheets(1)
.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
.Name = TABLE_NAME_NEW
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

End Sub


Jamie.

--