How to use VBA code to Extract rows of data meeting criteria

How to use VBA code to extract rows of data meeting criteria

Requirement:

The user is trying to extract data from a closed workbook meeting specific criteria.

This is what the user has:

A Workbook called "InvoiceList.xlsx", that stores a list of invoice that have been created by multiple sales staff. This workbook needs to stay closed so when a new invoice is created it can store the info in there.

Each row contains information as following...

A = Invoice Number in the this format Inv-170152
B = Date invoice was created
C = Sales Staff that created the invoice
D = Customer's name
E = Before tax amount
F = With tax amount
G = Job number
H = Quote number

What the user needs is...

Each sales staff needs to have his/her own list of invoices they created. The user has created new workbooks for each sales staff where the user would like to extract their invoice list into.

The user needs a code that would look for "John Bergen" in column C and extract all the data from that row A - H and paste it in "InvoicesJohn.xlsm" in the next empty row. A1:H1 are column headers so the pasting needs to start at A2.

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/148250-extract-rows-of-data-meeting-criteria

Solution:

Try this where the data is pulled from a tab called Sheet1 from a column header titled Created By where the records in that column equal John Bergen (change the strMySQL line to suit):

Code:

Option Explicit
Sub GetDataFromClosedWB()
 
    'This code is primarily based on this thread:
    'http://stackoverflow.com/questions/27908561/use-excel-vba-to-change-the-value-of-a-cell-in-a-closed-workbook
 
    '//Declare variables//
    Dim objConn       As Object
    Dim objRec        As Object
    Dim strMySQL      As String
    Dim strDataSource As String
    Dim strConnString As String
    Dim lngPasteRow   As Long
   
    Set objConn = CreateObject("ADODB.Connection")
    Set objRec = CreateObject("ADODB.Recordset")
   
    'Full path and file name - change to suit. Note workbook can be closed or opened.
    strDataSource = "C:\My Data\InvoiceList.xlsx"
   
    strConnString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=" & strDataSource & ";" & _
                "Extended Properties=""Excel 12.0;HDR=YES"";"
   
    objConn.Open strConnString
    
    'Tab name and field (column) header to retrieve the data. Here the data will be pulled from 'Sheet1' from a column titled 'Created By' where the entries in that column equal 'John Bergen'.
    'Change to suit - but note the sheet name MUST have trailing '$'.
    strMySQL = "SELECT * FROM [Sheet1$] WHERE [Created By] = ""John Bergen"";"
   
    With objRec
        'Return the last value in a field
        .CursorType = 2 'adOpenDynamic http://stackoverflow.com/questions/1...lling-backward Need a CursorType of 2 i.e. 'adOpenDynamic' to enable MoveLast, MoveNext and MovePrevious
        .Open strMySQL, objConn
        'Find the last row across columns A to H (inclusive) on the active sheet and increment it by one. Assumes the active sheet is not blank (will error out if it is).
        lngPasteRow = Range("A:H").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
        Range("A" & lngPasteRow).CopyFromRecordset objRec
        .Close
        'Return the recordcount of the dataset
        .CursorType = 3 'adOpenStatic For a list of these literal values refer http://www.w3schools.com/asp/prop_rs_cursortype.asp
        .Open strMySQL, objConn
        If .RecordCount = 0 Then
            MsgBox "No records were imported!!", vbCritical
        Else
            MsgBox .RecordCount & " records have now been imported.", vbInformation
        End If
    End With
   
    'Tidy up - remove objects from memory to free up space
    objConn.Close
    Set objRec = Nothing
    Set objConn = Nothing
   
End Sub

Obtained from the OzGrid Help Forum.

Solution provided by Trebor76.