Filtering arrays

[David Macdonald]

I have a database in one WorkBook and want to transfer filtered data on
setarate sheets in another WorkBook.
One of the columns in the db is a 5 digit number and the sheets in the
destination Workbook are named with the same numbers.
I want to get all the rows containing the sheet name onto the correct sheets.
i.e. All the rows in WB1 referencing 12345 should be transfered to WB2 sheet
12345, all the rows in WB1 referncing 12346 should be transfered to WB2 sheet
12346, you get the idea...
I could just have Excel switch back and forth between the 2 workbooks,
filter, copy and paste OR (I thought) I could place the whole database in an
array, then filter for the results I need as I step through the different
sheets. Now I have my 3000 row x 16 column array BUT I can't figure how to
filter an array...
Should I just give up and let my users get dizzy watching Excel flick
between 2 workbooks for a couple of minutes ?

 

[Jacob Skaria]

Hi David

Suppose your data looks like

Col A Col B
Header 1 Header 2
111 1
111 2
111 3
222 1
222 2
222 3
333 1
333 2
333 3
333 4

the below macro will do what you are looking for..

Points to be noted
--Activesheet is the data sheet.
--Change the destination workbook name ("Book3"). If this is a saved
workbook it will need to have the extension .xls/.xlsx
--Try the below and feedback


Sub Macro()
Dim lngRow As Long, lngNextRow As Long
Dim wbDest As Workbook, ws As Worksheet
Set wbDest = Workbooks("Book3")

For lngRow = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If Trim(Range("A" & lngRow)) <> "" Then
Set ws = wbDest.Sheets(CStr(Trim(Range("A" & lngRow))))
lngNextRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
Rows(lngRow).Copy ws.Rows(lngNextRow)
Set ws = Nothing
End If
Next
End Sub


If this post helps click Yes

 

[Patrick Molloy]

do you know how to connect to an excel workbook as a database?
if so, your problem is very simple
set populate a records set with "SELECT DISTINCT %column% FROM %table%"
where you replace the two tokens by appropraie values
then for each item in the recordset
you run a "SELECT * FROM %table% WHERE %column%='" & item & "'"

are you ok with this ?

 

[David Macdonald]

Using ODBC you mean ? I hadn't thought of that.

 

[David Macdonald]

OK I set up 2 new workbooks and your code works a dream!
Now I just have to try it out on my originals...

 

[David Macdonald]

This line caused an error:
Set ws = wbDest.Sheets(CStr(Trim(Range("A" & lngRow))))

After testing, I realised it's because it won't find a destination sheet for
all the values in column A.
I've put in "on error resume next". That works (unbelieveably quickly!) but
will it be enough and not create problems later ?

 

[Patrick Molloy]

here's an examople. in the develp,emt environment set a referebce (TOOLS/
REFERENCES) to the Microsoft Active Data Objects 2.6 Library
and you can use this code:

Note: My excel workbook (2003) is called Testdatabase/xls and has a table,
name range is testdata. One of the columns, (the 2nd) os called PROD

so what the code does is to read distict values from the prod column into
the recordset (rst). Then for each record in rst, it read all values where
into a 2nd record set (rst1), then adds a worksheet and names that worksheet,
finally dropping the data into it.





Option Explicit

Sub LoadFromExcelDatabase()

Dim Conn As ADODB.Connection
Dim RST As ADODB.Recordset
Dim RST1 As ADODB.Recordset
Dim strConn As String
Dim SQL As String
Dim ws As Worksheet
Dim cl As Long

Dim sExcelSourceFile As String

sExcelSourceFile = "E:\Excel\Excel_database\Testdatabase.xls"

strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel
8.0;"
strConn = strConn & "Data Source="
strConn = strConn & sExcelSourceFile

Set Conn = New ADODB.Connection
Conn.Open strConn

Set RST = New ADODB.Recordset
Set RST1 = New ADODB.Recordset
SQL = "SELECT DISTINCT [PROD] FROM testdata"

RST.Open SQL, Conn, adOpenStatic


' RST.Open SQL, Conn, adOpenStatic


Do Until RST.EOF
SQL = "SELECT * from testdata where [PROD]='" & RST.Fields(0) & "'"
RST1.Open SQL, Conn, adOpenStatic

Set ws = Worksheets.Add
ws.Name = RST.Fields(0)

For cl = 1 To RST1.Fields.Count
ws.Cells(1, cl).Value = RST1.Fields(cl - 1).Name
Next
ws.Range("A2").CopyFromRecordset RST1
RST1.Close
Set ws = Nothing

RST.MoveNext
Loop





RST.Close

Conn.Close

Set RST = Nothing
Set Conn = Nothing

End Sub

 

[Patrick Molloy]

excuse typos! blimy!

:

Here's an example. in the develpment environment set a reference (TOOLS/
REFERENCES) to the Microsoft Active Data Objects 2.6 Library and you can use
this code:
Note: My excel workbook (2003) is called Testdatabase.xls and has a table,
name range is testdata. One of the columns, (the 2nd) os called PROD.
So what the code does is to read distinct values from the prod column into
the recordset (rst). Then for each record in rst, it reads all values into a
2nd record set (rst1), then adds a worksheet and names that worksheet,
finally dropping the data into it.


Option Explicit

Sub LoadFromExcelDatabase()

Dim Conn As ADODB.Connection
Dim RST As ADODB.Recordset
Dim RST1 As ADODB.Recordset
Dim strConn As String
Dim SQL As String
Dim ws As Worksheet
Dim cl As Long

Dim sExcelSourceFile As String

sExcelSourceFile = "E:\Excel\Excel_database\Testdatabase.xls"

strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel
8.0;"
strConn = strConn & "Data Source="
strConn = strConn & sExcelSourceFile

Set Conn = New ADODB.Connection
Conn.Open strConn

Set RST = New ADODB.Recordset
Set RST1 = New ADODB.Recordset
SQL = "SELECT DISTINCT [PROD] FROM testdata"

RST.Open SQL, Conn, adOpenStatic

Do Until RST.EOF
SQL = "SELECT * from testdata where [PROD]='" & RST.Fields(0) & "'"
RST1.Open SQL, Conn, adOpenStatic

Set ws = Worksheets.Add
ws.Name = RST.Fields(0)

For cl = 1 To RST1.Fields.Count
ws.Cells(1, cl).Value = RST1.Fields(cl - 1).Name
Next
ws.Range("A2").CopyFromRecordset RST1
RST1.Close
Set ws = Nothing

RST.MoveNext
Loop
RST.Close
Conn.Close

Set RST = Nothing
Set RST1 = Nothing

Set Con = Nothing

End Sub

 

[David Macdonald]

Thanks Patrick,
I think I'll use Jacob's solution this time round but I must get back into
ODB - in the past I only used it for moving data between Excel and Word.
--
WinXP - Office2003 (Italian)

excuse typos! blimy!

:

Here's an example. in the develpment environment set a reference (TOOLS/
REFERENCES) to the Microsoft Active Data Objects 2.6 Library and you can use
this code:
Note: My excel workbook (2003) is called Testdatabase.xls and has a table,
name range is testdata. One of the columns, (the 2nd) os called PROD.
So what the code does is to read distinct values from the prod column into
the recordset (rst). Then for each record in rst, it reads all values into a
2nd record set (rst1), then adds a worksheet and names that worksheet,
finally dropping the data into it.


Option Explicit

Sub LoadFromExcelDatabase()

Dim Conn As ADODB.Connection
Dim RST As ADODB.Recordset
Dim RST1 As ADODB.Recordset
Dim strConn As String
Dim SQL As String
Dim ws As Worksheet
Dim cl As Long

Dim sExcelSourceFile As String

sExcelSourceFile = "E:\Excel\Excel_database\Testdatabase.xls"

strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel
8.0;"
strConn = strConn & "Data Source="
strConn = strConn & sExcelSourceFile

Set Conn = New ADODB.Connection
Conn.Open strConn

Set RST = New ADODB.Recordset
Set RST1 = New ADODB.Recordset
SQL = "SELECT DISTINCT [PROD] FROM testdata"

RST.Open SQL, Conn, adOpenStatic

Do Until RST.EOF
SQL = "SELECT * from testdata where [PROD]='" & RST.Fields(0) & "'"
RST1.Open SQL, Conn, adOpenStatic

Set ws = Worksheets.Add
ws.Name = RST.Fields(0)

For cl = 1 To RST1.Fields.Count
ws.Cells(1, cl).Value = RST1.Fields(cl - 1).Name
Next
ws.Range("A2").CopyFromRecordset RST1
RST1.Close
Set ws = Nothing

RST.MoveNext
Loop
RST.Close
Conn.Close

Set RST = Nothing
Set RST1 = Nothing

Set Con = Nothing

End Sub