1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  3. When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

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

Discussion in 'VBA Macros' started by jonastiger, Dec 19, 2017.

  1. jonastiger

    jonastiger New Member

    Messages:
    16
    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 (vb):
    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
    Chirag R Raval likes this.
  2. Deepak

    Deepak Excel Ninja

    Messages:
    2,842
    Pls upload the sample data file as well as expected output file.
  3. jonastiger

    jonastiger New Member

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

    Attached Files:

  4. Chihiro

    Chihiro Excel Ninja

    Messages:
    4,923
    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.
    Chirag R Raval likes this.
  5. jonastiger

    jonastiger New Member

    Messages:
    16
    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
  6. Chihiro

    Chihiro Excel Ninja

    Messages:
    4,923
    Something like below using ADO.

    Code (vb):
    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.
    Last edited: Dec 19, 2017
    YasserKhalil likes this.
  7. jonastiger

    jonastiger New Member

    Messages:
    16
    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

    Attached Files:

  8. Chihiro

    Chihiro Excel Ninja

    Messages:
    4,923

    Attached Files:

  9. Chihiro

    Chihiro Excel Ninja

    Messages:
    4,923

    Attached Files:

  10. jonastiger

    jonastiger New Member

    Messages:
    16
    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
  11. Chihiro

    Chihiro Excel Ninja

    Messages:
    4,923
    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?
  12. jonastiger

    jonastiger New Member

    Messages:
    16
    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
  13. Chihiro

    Chihiro Excel Ninja

    Messages:
    4,923
    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.
  14. jonastiger

    jonastiger New Member

    Messages:
    16
    Right. This I've done, but how do I filter it using named range?
  15. Chihiro

    Chihiro Excel Ninja

    Messages:
    4,923
    ... 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.
  16. jonastiger

    jonastiger New Member

    Messages:
    16
    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)

    and points to Structure
  17. Chihiro

    Chihiro Excel Ninja

    Messages:
    4,923
    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.
  18. jonastiger

    jonastiger New Member

    Messages:
    16
    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?
  19. Chihiro

    Chihiro Excel Ninja

    Messages:
    4,923
    Yes. I often have both on my files.
    Either ".xlsm" or ".xlsb" can house both.
  20. jonastiger

    jonastiger New Member

    Messages:
    16
    Hi again
    After an update of excel file, PQ returns error in:
    Code (vb):
    = Table.NestedJoin(#"Changed Type",{"GP"},#"Estrutura GAN",{"Gestor Projecto"},"NewColumn",JoinKind.LeftOuter)
    (my translation)

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

    Chihiro Excel Ninja

    Messages:
    4,923
    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.
  22. jonastiger

    jonastiger New Member

    Messages:
    16
    This is the code:

    In ListStructureGAN (Only connection)

    In ListEstrutGAN

  23. Chihiro

    Chihiro Excel Ninja

    Messages:
    4,923
    ... This doesn't tell me what the query name is. Upload sample file and I can tell you where you went wrong.
  24. jonastiger

    jonastiger New Member

    Messages:
    16
    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 (vb):
    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
  25. jonastiger

    jonastiger New Member

    Messages:
    16
    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 (vb):
    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?
    Last edited: Dec 27, 2017

Share This Page