Copy filtered data from closed workbook based on named range in activebook

jonastiger · Dec 19, 2017

Hi
I wonder if someone can help me with this:

I have found this code and I need to fit it to my needs but I don't how to do:

There´s a file (Closed.xlsx) which is daily exported from a server, with variable size each day (>100000 rows). I need to filter and copy specific data (cols 1,3,8,24,27) from that file based on criteria (named range called "TECH" which information exists in col 8). TECH has the names of a specific technician team (John, Richard, Charles, ...). Filtered Data will be pasted in Open.xlsm Sheet "Report" (same folder).
I work with Excel 2013/2016

My goal is: open Workbook "Open.xlsm" Sheet "Report" and automatically update filtered data
I did search and ask for help to other sources, but no success.

Code:

Option Explicit

'you can extract data from a closed file by using an
'XLM macro. Credit for this technique goes to John
'Walkenback > http://j-walk.com/ss/excel/tips/tip82.htm

Sub GetDataDemo()

Dim FilePath$, Row&, Column&, Address$


'change constants & FilePath below to suit
'***************************************
Const FileName$ = "Closed.xlsx"
Const SheetName$ = "DataList"
Const NumRows& = 100000 'Need to configure range from A1 to last row non blank to get range exact size
Const NumColumns& = 28 'Or setup only cols 1,3,8,24,27
FilePath = ActiveWorkbook.Path & "\"
'***************************************


DoEvents
Application.ScreenUpdating = False
If Dir(FilePath & FileName) = Empty Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Exit Sub
End If
For Row = 1 To NumRows
For Column = 1 To NumColumns
Address = Cells(Row, Column).Address 'How to setup named range
Cells(Row, Column) = GetData(FilePath, FileName, SheetName, Address)
Columns.AutoFit
Next Column
Next Row
ActiveWindow.DisplayZeros = False
End Sub

Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("A1").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function

Thank you very much for your attention.
JT

Deepak · Dec 19, 2017

Pls upload the sample data file as well as expected output file.

jonastiger · Dec 19, 2017

Hi, here's a sample of both files (too much shorter than the real ones). These files stay always on same folder

Chihiro · Dec 19, 2017

What version of Excel do you use? And do you have access to PowerQuery?

This would be the simplest method and will be quite easy to maintain.

If not, then I'd suggest using ADO to pull data from closed workbook. Using SQL statement including IN statement.

jonastiger · Dec 19, 2017

Hi
As I' ve mentioned above, I work with Excel 2013/2016
I'm trying Power Query too, but i don't know how to filter data using the named range

Chihiro · Dec 19, 2017

Something like below using ADO.

Code:

Sub GetDataInList()
Dim fPath As String: fPath = ThisWorkbook.Path
Dim fName As String: fName = "Closed.xlsx"
Dim sName As String: sName = "DataList"
Dim mList As Range: Set mList = Range("Tabela1[TECH]")
Dim cn As Object, rs As Object
Dim cel As Range
Dim iCols As Long, i As Long
Dim strQuery As String, mStr As String
Dim resA(), tempA
  
    Set cn = CreateObject("ADODB.Connection")
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & IIf(Right(fPath, 1) = "\", fPath, fPath & "\") & fName & ";" & _
                            "Extended Properties=""Excel 12.0 Xml;HDR=Yes;"""
        .CursorLocation = 3
        .Open
    End With
  
    strQuery = "SELECT t1.[COD], t1.[CLIENT], t1.[TECH], t1.[DATE], t1.[PDS] FROM [" & sName & "$] as t1"
    If Not mList Is Nothing Then
        For Each cel In mList.Cells
            mStr = IIf(Len(mStr) = 0, Chr(34) & cel.Value & Chr(34), mStr & ", " & Chr(34) & cel.Value & Chr(34))
        Next
        strQuery = strQuery & " WHERE t1.[TECH] IN (" & mStr & ")"
    End If
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open strQuery, cn, 1, 3
  
    If rs.RecordCount > 1 Then
        For iCols = 0 To rs.Fields.Count - 1
            With Sheets("Report")
                .Cells(5, iCols + 2) = rs.Fields(iCols).Name
            End With
        Next
      
        Folha1.Range("B6").CopyFromRecordset rs
    End If
    rs.Close
    cn.Close
End Sub

I'll do sample for PQ if I have time later today.

jonastiger · Dec 19, 2017

Hi Chihiro
Thank you for your time and help.

However, executing macro returns an error (see image attached):

Set cn = CreateObject("ADODB.Connection")
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & IIf(Right(fPath, 1) = "\", fPath, fPath & "\") & fName & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=Yes;"""
.CursorLocation = 3
.Open

I actived Microsoft Data Objects ActiveX 6.1 Library

Chihiro · Dec 19, 2017

So you have both workbooks in same folder right?

Had no issue on my end with your sample file.

As well, no need to add reference to AcitveX.

See attached sample.

Edit: Oh, and I assume you have appropriate driver installed. If not...
https://www.microsoft.com/en-ca/download/details.aspx?id=13255

Chihiro · Dec 19, 2017

Here's method using PQ.
Using Named Range to pass Workbook's path to PQ.
Merged Tables using Left Outer.
See attached.
Put the file in same folder as your Closed.xlsx

You can read the concept of how to pass Named Range to PQ in my post below (post #5).
https://chandoo.org/forum/threads/useful-powerquery-tricks-chihiros-notes.35658/

jonastiger · Dec 20, 2017

Hi
First of all, thank you so much for your precious help and readiness.
I'm sorry to bother you once again but I still have some problems with your code:
Using ADO option, I think I did everything right following your instructions (downloaded and installed driver - AccessDatabaseEngine_X64.exe - #Post8) and still doesn't work. I've tried with your sample ant it worked at first using, but testing again after small changes in data, it returns the same error reported in #Post7. So I don't know what I'm doing wrong.

About Power Query, I'm still exploring that option and it seems to have great skills. I'm studying your sample and tutorials and trying to fit it to my real files.
For now, it returns an error referring fPath

Chihiro · Dec 20, 2017

Without you telling me exactly what changes were made that broke the process, it's pretty much impossible for me to give you help.

As for fPath returning error, at what stage is it returning error? Have you actually created named range that hold folder path value?

jonastiger · Dec 20, 2017

Changes made were update source file and named range TECH. As I said in first post, source file (Closed.xlsx) has variable size each day. Also, TECH can be updated adding or removing names. So, for a test, there were the chaanges I've made. But it returns same error and highlights the line ".Open".

For PQ option, the issue was solved. It was missing something. After new try, it worked perfectly.
However, and if you don't mind, I have another request:
How do I filter data (complete rows) in another workbook, based on the same named range but, in this case, target column in workbook (List Structure) has a different name ("Engineers"). Sheet name is "List Structure GAN". This file is also updated in a daily basis to the same folder of the others

Chihiro · Dec 20, 2017

Number of row, does not matter one way or another it's querying entire sheet as one table. Nor does number of names in TECH table (though, if it gets to be ridiculous size... it can cause slow down and timeout, but not on cn.Open stage).

If TECH table becomes too large. Then I'd recommend migrating this list into Closed.xlsx and use Left Join to pull data instead of using IN statement.

Upload files where you get the error and I can take a look.

As for PQ, you just need to create separate query to the new workbook and select appropriate sheet in the PQ editor.

jonastiger · Dec 20, 2017

As for PQ, you just need to create separate query to the new workbook and select appropriate sheet in the PQ editor.

Right. This I've done, but how do I filter it using named range?

Chihiro · Dec 20, 2017

... did you read the post I linked and also look in the editor for the steps that was applied? You'll see that I used Left Outer Join to filter for only items that match list for TECH. Do same/similar operation for new query.

jonastiger · Dec 21, 2017

...You'll see that I used Left Outer Join to filter for only items that match list for TECH. Do same/similar operation for new query.

Sheet name is "List Structure GAN"

Is there a problem if sheet name has spaces between words?

I get this error in:
= Table.NestedJoin(#"Changed Type",{"Gestor Projecto"},List Structure GAN,{"Gestor Projecto"},"NewColumn",JoinKind.LeftOuter)

Expression.SyntaxError: Expected token Comma.

and points to Structure

Chihiro · Dec 21, 2017

Nope. PQ can deal with it. But your syntax is off.

If you used GUI to create Join. It should produce something like...
#"List Structure GAN" as reference. Not just, List Structure GAN alone. Hence the syntax error.

jonastiger · Dec 21, 2017

Solved. I had a mistake refferring the sheet.
Thank you very much to open my mind to this tool and now I'm very excited to explore it more deeply.
One more little question, in advance:
PQ and VBA can co-habite in the same file? Or "*.xlsm" can include PQ queries?

Chihiro · Dec 21, 2017

Yes. I often have both on my files.
Either ".xlsm" or ".xlsb" can house both.

jonastiger · Dec 22, 2017

Hi again
After an update of excel file, PQ returns error in:

Code:

= Table.NestedJoin(#"Changed Type",{"GP"},#"Estrutura GAN",{"Gestor Projecto"},"NewColumn",JoinKind.LeftOuter)

Expression.Error:
The name "Estrutura GAN" was not recognized. Make sure it is spelled correctly
.

(my translation)

But sheet name is correct.
Can you tell me what's wrong?

Chihiro · Dec 22, 2017

It's not really sheet name you should check. But rather, the query created off of the sheet. What's it named? Make sure that there are no extra spaces etc.

jonastiger · Dec 22, 2017

This is the code:

In ListStructureGAN (Only connection)

let
Origem = Excel.Workbook(File.Contents("C:\Users\JonasTiger\Dropbox\PROJECTOS_GAN\Matriz\ListStructureGAN.xlsx"), null, true),
#"Estrutura GAN_Sheet" = Origem{[Item="Estrutura GAN",Kind="Sheet"]}[Data],
#"Cabeçalhos Promovidos" = Table.PromoteHeaders(#"Estrutura GAN_Sheet", [PromoteAllScalars=true]),
BasicData = Table.TransformColumnTypes(#"Cabeçalhos Promovidos",{{"Codigo", type text}, {"Cliente", type text}, ..., {"Cliente Interno", type text}})
in
BasicData

In ListEstrutGAN

let
Origem = Excel.Workbook(File.Contents("C:\Users\JonasTiger\Dropbox\PROJECTOS_GAN\Matriz\ListStructureGAN.xlsx"), null, true),
Source = Excel.CurrentWorkbook(){[Name="Tabela5"]}[Content],
#"Changed Type" = Table.TransformColumnTypes(Source,{{"GP", type text}}),
#"Merged Queries" = Table.NestedJoin(#"Changed Type",{"GP"},#"Estrutura GAN",{"Gestor Projecto"},"NewColumn",JoinKind.LeftOuter),
#"Expanded NewColumn" = Table.ExpandTableColumn(#"Merged Queries", "NewColumn", {"Codigo", "Cliente", ..., "Cliente Interno"}, {"Codigo", "Cliente", ..., "Cliente Interno"}),
#"Reordered Columns" = Table.ReorderColumns(#"Expanded NewColumn",{"Codigo", "Cliente", ..., "Cliente Interno"}),
#"Sorted Rows" = Table.Sort(#"Reordered Columns",{{"Codigo", Order.Ascending}})

in
#"Sorted Rows"

Chihiro · Dec 22, 2017

... This doesn't tell me what the query name is. Upload sample file and I can tell you where you went wrong.

jonastiger · Dec 26, 2017

Hi
Hope you had a good holiday
Sorry to bother once again.

I solved the last issue by duplicating the GP query and fit with new targets. This is great but, because the source files are very very big, it takes too long to update my excel master. filtering by GP all of them, each query returns more than 30000 rows. So, I'm trying PQ and VBA in separated options to find the fastest way to fill and update data.

Now in VBA, I need to adapt the ADO code you provided above to get data from more excel files, all in the same folder. This is my failed test:

Code:

Sub GetDataInList()
Dim fPath AsString: fPath = ThisWorkbook.Path
Dim fName As String: fName = "Closed.xlsx"
Dim fName02 As String:fName02 = "ClosedTest02.xslx"
Dim fName03 As String:fName03 = "ClosedTest03.xslx"
Dim sName As String: sName = "DataList"
Dim sName02 As String: sName02 = "DataList02"
Dim sName03 As String: sName03 = "DataList03"
Dim mList As Range: Set mList = Range("Tabela1[TECH]")
Dim cn AsObject, rs AsObject
Dim cel As Range
Dim iCols AsLong, i AsLong
Dim strQuery As String, mStr As String
Dim strQuery02 As String, mStr02 As String
Dim strQuery03 As String, mStr03 As String
Dim resA(), tempA

  Set cn = CreateObject("ADODB.Connection")
  With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & IIf(Right(fPath, 1) = "\", fPath, fPath & "\") & fName & ";" & _
                          "Extended Properties=""Excel 12.0 Xml;HDR=Yes;"""
        .CursorLocation = 3
        .Open
  EndWith
'here is my problem. How do I set strQuery02 and strQuery03?
    strQuery = "SELECT t1.[COD], t1.[CLIENT], t1.[TECH], t1.[DATE], t1.[PDS] FROM [" & sName & "$] as t1"
  IfNot mList IsNothingThen
      ForEach cel In mList.Cells
            mStr = IIf(Len(mStr) = 0, Chr(34) & cel.Value & Chr(34), mStr & ", " & Chr(34) & cel.Value & Chr(34))
      Next
        strQuery = strQuery & " WHERE t1.[TECH] IN (" & mStr & ")"
  EndIf
  Set rs = CreateObject("ADODB.Recordset")
    rs.Open strQuery, cn, 1, 3

  If rs.RecordCount > 1 Then
      For iCols = 0 To rs.Fields.Count - 1
          With Sheets("Report")
                .Cells(5, iCols + 2) = rs.Fields(iCols).Name
          EndWith
      Next
   
        Folha1.Range("B6").CopyFromRecordset rs
  EndIf
    rs.Close
    cn.Close
EndSub

Thank you in advance

jonastiger · Dec 27, 2017

Forgot to mention that all source files and sheets have different names.
I replicate Sub GetDataInList() to each source file (Sub GetDataInList1, Sub GetDataInList2,...). All working (a bit slowly but) fine, except one (Sub GetDataInList2):

Code:

strQuery = "SELECT t1.[Cod], t1.[Client], t1.[FIN], t1.[Proj Manager], t1.[Data Provider Technician], t1.[#], t1.[Site], t1.[Info Site], t1.[Pri Service.], t1.[Info Pri Service], t1.[Access], t1.[Info Access], t1.[W Team], t1.[W State], t1.[W Prev Date], t1.[Tecnol], t1.[Profile PR/BK], t1.[ID Access], t1.[Class], t1.[R State], t1.[R Prev Date], t1.[Target Date], t1.[Urgent], t1.[Lin State], t1.[Vertical], t1.[Provider], t1.[Lin Type], t1.[Service Type], t1.[Lin Work Date], t1.[Lin Production Date] FROM [" & sName & "$] as t1"
    If Not mList Is Nothing Then
        For Each cel In mList.Cells
            mStr = IIf(Len(mStr) = 0, Chr(34) & cel.Value & Chr(34), mStr & ", " & Chr(34) & cel.Value & Chr(34))
        Next
        strQuery = strQuery & " WHERE t1.[Proj Manager] IN (" & mStr & ")"
    End If
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open strQuery, cn, 1, 3 'here returns error: ('' is not a valid name. make sure that it does not include invalid characters or punctuation and that is not too long)

I can't find the error.
Can you help, please?

Copy filtered data from closed workbook based on named range in activebook

Member

Excel Ninja

Member

Attachments

Excel Ninja

Member

Excel Ninja

Member

Attachments

Excel Ninja

Attachments

Excel Ninja

Attachments

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Member