View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Ben McClave Ben McClave is offline
external usenet poster
 
Posts: 173
Default Macro to choose data and export in another workbook

Jerry,

The macros below should do the trick. All you'll need to do is set up a drop-down list in any cell on your "HOME" sheet (using Data Validation). In a module of your workbook, add the code below and be sure to point "sParameter" to the correct cell in your workbook (this macro assumes that the drop-down list is in cell A1). Then add a button to the sheet and assign it the macro "CopyToNew".

Hope this helps,

Ben

CODE:
------------------------------
Option Explicit
Public sParameter As String
Public wbNew As Workbook

Sub CopyToNew()
'Set sParameter range to the range containing your drop-down list
sParameter = ThisWorkbook.Sheets("HOME").Range("A1").Value

Set wbNew = Workbooks.Add 'Adds a new workbook

'Copy header row to new sheet(assumes headers in row 1 of "ICD" sheet)
ThisWorkbook.Sheets("ICD").Rows(1).Copy wbNew.Sheets(1).Range("A1")

'Call macro to move the matching row(s)
MoveSheet wbNew.Sheets(1).Range("A2")

End Sub

Sub MoveSheet(rCopy As Range)
'Requires reference to ActiveX Data Objects Libraray
Dim sSQL As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strFile As String
Dim strCon As String

'Create recordset using SQL string
strFile = ThisWorkbook.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

sSQL = "SELECT * FROM [ICD$] WHERE [" & ThisWorkbook.Sheets("ICD").Range("A1").Value & "] = " & _
Chr(39) & sParameter & Chr(39) & ";"

rs.Open sSQL, cn

'Copy Records to the new workbook
rCopy.CopyFromRecordset rs

'Close connection and exit
cn.Close
Set rCopy = Nothing
Set wbNew = Nothing

End Sub