CODEWITHSUNDEEP
vbaexcel
user1717622
user1717622

Reputation: 323

ADO functionality.. copy, filter, paste from closed workbook to active wrokbook

I am currently looking for an alternative to the solution below, but using the ADO functionality so that the source workbook isn't opened. I am imagining this will decrease processing time?

Your thoughts..

Thanks

Sub CopyFilteredValuesToActiveWorkbook()

    Dim wbSource As Workbook, wbDest As Workbook
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim rngSource As Range, rngDest As Range

    Set wbSource = Workbooks.Open("\\Linkstation\rrm\X_DO_NOT_TOUCH_CC\MasterLogFile\Masterlogfile.xlsx", , True) 'Readonly = True
    Set wsSource = wbSource.Worksheets("LogData")
    wsSource.Range("$A$1:$H$3").AutoFilter Field:=3, Criteria1:="Opera"
    Set rngSource = wsSource.Range("A:Z")

    Set wbDest = ThisWorkbook
    Set wsDest = wbDest.Worksheets("MLF")
    Set rngDest = wsDest.Range("A:Z")

    rngDest.Value = rngSource.Value 'Copies values over only, if you need formatting etc we'll need to use something else

    wbSource.Close (False) 'Close without saving changes

    End Sub

Upvotes: 0

Views: 981

Answers (2)

kb_sou
kb_sou

Reputation: 1057

You could use a reference to Active X Data Objects 6.0, to use SQL queries

Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1

Public Sub GetValues (path as String, destination as Range)
    Dim conStr as String, strSQL as string
    Dim con as new ADODB.Connection, rs as new ADODB.Recordset

    conStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & path & "';" & _
             "Extended Properties=""Excel 12.0;HDR=YES;IMEX=1;"";"
    strSQL = "SELECT * FROM [LogData$] WHERE [CriteriaColumn] = 'Opera'"

    con.Open conStr
    rs.open strSQL, con, adOpenStatic, adLockOptimistic, adCmdText
    destination.CopyFromRecordset rs
    rs.close
    con.close
End Sub

Where the CriteriaColumn is the Header of the Column used as criteria to filter

You can call the subroutine as follows:

Dim path as string, rngDest as Range
path = "\\Linkstation\rrm\X_DO_NOT_TOUCH_CC\MasterLogFile\Masterlogfile.xlsx"
'The Upper left cell of the range that will receive the data:
Set rngDest = ThisWorkbook.Worksheets("MLF").Range("A1") 
GetValues path, rngDest

Upvotes: 2

ALX
ALX

Reputation: 16

You are missing this line: 

Set rs = CreateObject("ADODB.Recordset")

For some reason Win XP will not run without it. It should be placed right after con.Open conStr.

Upvotes: 0

Related Questions