Select rows from closed workbook using criteria

[tazz]

Hello all,
I need your expert analysis to fix the macro inside the workbook WB_RECEIVER.
For a couple of days I try to figure out what I did wrong.
This macro is supposed to select data from a closed workbook using as filter criteria the value in cell G1.
Please find the attached files as reference.
Thank you for your help

 

[Nebu]

Hi:

Use the following code

Sub PullData()

    Dim cnStr, query, Str, fileName As String
    Dim rs As ADODB.Recordset

    fileName = "Your file path\WB_SOURCE.xlsx"
    cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & fileName & ";" & _
              "Extended Properties=Excel 12.0"

    Str = Sheet1.Range("A1")
    query = "SELECT * FROM [Sheet1$] WHERE [ID] =" & "'" & Str & "'"

    Set rs = New ADODB.Recordset
    rs.Open query, cnStr, adOpenUnspecified, adLockUnspecified
    Sheet2.Cells.Clear

    Dim cell As Range, i, k1 As Long
    With Sheet2
        For i = 0 To 4
          .Cells(1, i + 1).Value = rs.Fields(i).Name
        Next i
      .Range("A2").CopyFromRecordset rs
      .Range("A1").EntireColumn.AutoFit
    End With

    rs.Close

End Sub

Note: Results in sheet2, Filter in Sheet1 Cell A1,
Click on Tools » References »Microsoft ActiveX Data Objects 6.1 in VBA Editor before using the code.

Thanks

 

[tazz]

Hello Nebu,
Thank you for your reply and solution provided.
I followed your indication to change path and enable ActiveX DO 6.1 but I get a message of error: "Sheet1$ not a valid name" and when I debug the line starting with "rs. open query.... " is yellow. Do you know what the probkem could be?
Also, since you are waaaay to advance compare to me perhaps you could spare some time and take a look at my code. I would really like to know what I did wrong and learn from my mistakes.(I learn VB by myself)

Thank you for your time and help.

 

[Nebu]

Hi:

Sheet1$ error is because your WB_Source file will not be having Sheet number 1 , identify the correct no of the sheet in which your data is and give that sheet number in the code it will work.(Note: Sheet number and sheet names are different, sheet number is basically the index number of the sheets in a workbook)

As far as your macro goes, you are setting the range (Set myRange = Workbooks("WB_SOURCE.xlsx").Sheets("SOURCE").Range("A" & countRows + 1 & ":E" & i)) before opening the workbook WB_Source, here the macro will get confused if you try to assign a range from a workbook which is not open.

Thanks

 

[tazz]

Hello Nebu,
I changed the name of the sheet and it worked for WB_SOURCE.
I tried the same thing with another file where I need to extract data from, I changed name of the file and of the sheet where data is located(this time is sheet 3 named "NEW DATA") )and I get the same error on this line:
"rs.Open query, cnStr, adOpenUnspecified, adLockUnspecified"

Also regarding the code that you took a look I placed the line with "set..." after the WB_SOURCE is open. Still stuck with this code.
If your time allows you, please alter this code to make some sense.

Thank you for your time.

Sub AutoCopy()

Dim pasteTo As Range
Dim countRows
Dim i As Long
Dim myRange As Range

countRows = Application.CountA(Range("A:A"))
Workbooks.Open fileName:="C:\WB_SOURCE.xlsx"
If i = countRows Then Exit Sub

Set myRange = Workbooks("WB_SOURCE.xlsx").Sheets("SOURCE").Range("A" & countRows + 1 & ":E" & i)
myRange.AutoFilter Field:=1, Criteria1:="=" & Range("G1").Value.Select
Selection.Copy
Workbooks("WB_SOURCE.xlsx").Close

Set pasteTo = Sheets("RECEIVER").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
ThisWorkbook.ActiveSheet.Paste Destination:=pasteTo
Application.CutCopyMode = False

End Sub

 

[Nebu]

Hi:

I have modified the code. Its working now !!!

Sub AutoCopy()

Dim i As Long
Dim myRange As Range

Workbooks.Open fileName:="\\its\desktop\Profiles\sudhakn\Home Directory\Documents\Downloads\WB_SOURCE.xlsx"
Set myRange = Workbooks("WB_SOURCE.xlsx").Sheets("SOURCE").Range("A1:E" & Workbooks("WB_SOURCE.xlsx").Sheets("SOURCE").Cells(Rows.Count, "A").End(xlUp).Row)

With myRange
.AutoFilter Field:=1, Criteria1:=ThisWorkbook.Sheets("RECEIVER").Range("G1")
.SpecialCells(xlCellTypeVisible).Copy Destination:=ThisWorkbook.Sheets("RECEIVER").Range("A1")
End With

Application.CutCopyMode = False
Workbooks("WB_SOURCE.xlsx").Close

End Sub

But I would recommend to use the code I had provided to you before, the key for the that code is the SQL statement " query = "SELECT * FROM [Sheet1$] WHERE [ID] =" & "'" & Str & "'""

Here
Sheet1$- the sheet number you are pulling data from
ID - is the field you are applying filter for.
Str- is dynamic string in this case any of the IDs available in your ID column, I fyou can get this logic right you will be alright with the code.

Thanks

 

[tazz]

Thank you so much for your code and for your time in dealing with my code. Have a great day.