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.

Loop all files in folder , Search for Instance & Copy Each Entire rows in active sheet

Discussion in 'VBA Macros' started by Chirag R Raval, Nov 24, 2017.

  1. Chirag R Raval

    Chirag R Raval Member

    Messages:
    505
    Dear All,

    Sub:- Loop all files in folder & Copy Entire rows in active sheet, first Search for Column Heading, Then in Entire that column for particular instance.

    I have many , same structured files in folder, each file have about 50,000 records with 69 columns.

    If query raised from parties or other situations (normally average every hourly) , for separate records on particular instance from each file , each time each & all files must be open & Search for particular instance, copy that row in currently newly open workbooks. That take huge efforts & consume time.

    I already study following links.

    My requirement is copy entire each founded rows instead of founded cell’s address & paths.

    I also check this link on that thread,

    https://excel.tips.net/T005598_Searching_Through_Many_Workbooks.html

    in this site & code, focus on particular bellow expression that work for only founded address..

    “strFirstAddress = rFound.Address
    same requirement is

    “My requirement is copy entire founded rows instead of founded cell’s address & paths.”

    I already check below lingk

    https://stackoverflow.com/questions/20687810/vba-macro-that-search-for-file-in-multiple-subfolders

    that also populate result as path & filenames only..


    my requirement is very close to below thread that search for named list

    https://chandoo.org/forum/threads/macro-to-search-text-in-all-xls-files-sub-folder-in-a-directory.28095/#post-168618

    on this thread, particular post no 7 I test successfully for search words in named range list

    ForEach cell In ThisWorkbook.Sheets("sheet1").Range("list")”,

    “My requirement is copy entire founded rows instead of founded cell’s address & paths.”

    If code , in each file, first search for particular column heading , if found that column, then search instance in only that columns , If found , entire row copy in active newly created workbook that’s all..

    If columns heading not found, then display message , so I can revise that heading for future smooth work,

    May be advance filter can help for fast work but I don’t know how to combine this with advance filter & how to copy entire row…

    If any help available , I will be thank full forever for this.


    Regards,

    Chirag Raval
  2. Marc L

    Marc L Excel Ninja

    Messages:
    3,695
    Hi !

    Just see next statements in VBA inner help and
    within codes of your own threads !

    Use Dir VBA function to scan files,
    Workbooks.Open to reach a workbook,
    Match (Excel help as a worksheet function) for column heading,
    better than any loop use a filter for instances,
    EntireRow.Copy or Range.Copy to copy cells …
  3. Chirag R Raval

    Chirag R Raval Member

    Messages:
    505
    Dear Sir @Marc L ,

    Thank you very much for guide line..
    Below code need modification as per your guide line (with requirement (commented) in it). really sorry but I don't know how to put match function & advance filter , & Copy entire row ..in it..

    Code (vb):

    Sub LoopThroughFiles()
        Dim file As Variant
        Dim sht As Worksheet, path As String, y As Range
        Dim i As Integer
        Dim kcell As Range
        Dim found As Variant

        Application.DisplayAlerts = False
        Application.ScreenUpdating = False

        i = 2
        path = ThisWorkbook.Sheets("sheet1").Range("a2").Value
        If Right(path, 1) <> "\" Then path = path & "\"
        file = Dir(path & "*.xls*")
        While (file <> "")
        Workbooks.Open path & file
        For Each kcell In ThisWorkbook.Sheets("sheet1").Range("list")

        For Each sht In ActiveWorkbook.Sheets
    '++++++++++++++++++++++++++++++++++++++++++
    ' REQUIRE -Match Function here For Search Columns Heading
    ' Match function return column number
    'If found,  below , searched heading's Column No. then search only in that columns as 'below  variable "Y, 'if not found that column , the message appear
    '+++++++++++++++++++++++++++++++++++++++++++++

        Set y = sht.Cells.Find(What:=kcell.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False)

        If y Is Nothing Then
        GoTo Skip:
        Else

    '++++++++++++++++++++++++++++++++++++++++++++++
    'REQUIRE:- Advanced Filter here for Advance filter for founded value of variable y '& copy entire row in active sheet

    '    ThisWorkbook.Sheets("sheet2").Range("a" & i).Value = kcell.Value
       '((( ThisWorkbook.Sheets("sheet2").Range("b" & i).Value = y.Address))))
    '    ThisWorkbook.Sheets("sheet2").Range("c" & i).Value = sht.Name
    '    ThisWorkbook.Sheets("sheet2").Range("d" & i).Value = file
    '    ThisWorkbook.Sheets("sheet2").Range("e" & i).Value = path
       i = i + 1
        End If
        '((((((found = y.Address)))))))

    Skip:
    Next sht
    Next kcell
    ActiveWorkbook.Close
          file = Dir()
      Wend
    On Error GoTo 0
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    End Sub

     
    I don't want to put this code in any sheet module,
    i want to put it in my personel.xlsb due to code always available when require
    if I put it in my personnel.xlsb so, i can avoid ,each time, operate any copy pasting in currently active newly opened file's sheet module.

    if , I prefer for code reside in personnel .xlsb,
    May be issue of This workbook and Active workbook will be raised ..
    as also don't know how to specify my currently opened unsaved new file where I want copy of rows ..
    & how to specify each saved and opened by code itself as an Active workbook..

    in short its requirement that perform this macro operation through personnel.xlsb as a third party & core operator between newly created file & each opening saved files..

    Hope for little help ..

    Regards,
    Chirag Raval
  4. Marc L

    Marc L Excel Ninja

    Messages:
    3,695
    Use a workbook object variable (see Set in VBA inner help)
    when creating your destination workbook
    and use this variable when needed.
    Release this variable before the end of procedure (Nothing) …

    Open a source workbook so it's the active workbook
    - or use another workbook variable -
    copy data to destination workbook then close source workbook
    before opening next source workbook …
  5. Chirag R Raval

    Chirag R Raval Member

    Messages:
    505
    Dear Sir @Marc L

    Many thanks for your effort to motivate me to focus towards this matter
    I will try & revert soon.

    Regards,
    Chirag Raval
  6. Chirag R Raval

    Chirag R Raval Member

    Messages:
    505
    Dear sir ,

    Seems hard for me.
    Please help..

    Chirag Raval
  7. Chirag R Raval

    Chirag R Raval Member

    Messages:
    505
    Dear all experts,

    please i request you to modify this macro code.

    Regards,

    Chirag Raval
  8. Marc L

    Marc L Excel Ninja

    Messages:
    3,695

    As we can't fill holes, activate Macro Recorder and operate manually.
    Then post here the generated code and crystal explain your technical issue.​
  9. Chirag R Raval

    Chirag R Raval Member

    Messages:
    505
    Dear Sir,

    I filled 1st hole-of match function that store ,Column Heading "Material" as column number in integer variable "y"

    Code (vb):

    With wOut
            Dim y As Integer
        y = WorksheetFunction.Match("Material", ActiveSheet.range("1:1"), 0)
    now there are need to use this column number in advance filter ..& copy filtered result in active sheet which is unsaved.

    Regards,
    Chirag Raval
  10. Marc L

    Marc L Excel Ninja

    Messages:
    3,695

    • Replace WorksheetFunction by Application !
    • Check result with IsError or IsNumeric function.
    Both points in case of search string does not exist …

    For the filter, start with Macro recorder.
  11. Chirag R Raval

    Chirag R Raval Member

    Messages:
    505
    Dear Sir @Marc L ,

    Thanks ,
    I applied as per your guidelines
    (1) .."Application.worksheetfunction"
    Code (vb):

    k = Application.WorksheetFunction.Match("Material", ActiveSheet.range("1:1"), 0)
     
    (2) for destination workbook i use as per guideline
    Dim wkbdest As Workbook & use that as
    Code (vb):
    Set wkbdest = ActiveWorkbook
    its okay..

    I don't know how to put on error & if not error, resume next..statements

    I already run whole code with support on set watch windows, as per below

    Code (vb):

    Sub LoopThroughFiles()
        Dim file As Variant
        Dim sht As Worksheet
        Dim path As String
        Dim y As range
        Dim i As Integer
        Dim kcell As range
        Dim found As Variant
        Dim k As Integer
        Dim wkbdest As Workbook
        Dim lastrow As Long
               
        Set wkbdest = ActiveWorkbook
        Application.DisplayAlerts = False
        Application.ScreenUpdating = False

        i = 2
        path = ActiveSheet.range("a2").Value
        If Right(path, 1) <> "\" Then path = path & "\"
        file = Dir(path & "*.xls*")
        While (file <> "")
       
        For Each kcell In wkbdest.Sheets("sheet1").range("list")
        Workbooks.Open path & file
              For Each sht In ActiveWorkbook.Sheets
    '++++++++++++++++++++++++++++++++++++++++++
    ' REQUIRE -Match Function here For Search Columns Heading
    ' Match function return column number 'If found,  below , searched heading's Column No.
    'then advance filter only in that columns as 'below  variable "k, 'if not found that column , the message appear
    '+++++++++++++++++++++++++++++++++++++++++++++
    k = Application.WorksheetFunction.Match("Material", ActiveSheet.range("1:1"), 0)
    '++++++++++++++++++++++++++++++++++++++++++++++
    'REQUIRE:- Advanced Filter here for Advance filter for founded value of variable y '& copy entire row in active sheet
    ' Private Sub Find_Click()
    Dim wbData As range
    Dim wbCriteria As range
    Dim wbExtract As range
    lastrow = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row
    ActiveSheet.range("BB1").Value = "material"
    ActiveSheet.range("BB2").Value = wkbdest.range("list").Value

        If ActiveSheet.AutoFilterMode Then ActiveSheet.Cells.AutoFilter
    Set wbCriteria = wkbdest.range("BB1:BB2")
          ActiveSheet.CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=wbCriteria, CopyToRange:=wkbdest, Unique:=False
          If y Is Nothing Then
        GoTo Skip:
        Else
    '
       i = i + 1
        End If
        '((((((found = y.Address)))))))

    Skip:
    Next sht
    Next kcell
    ActiveWorkbook.Close
          file = Dir()
      Wend
    On Error GoTo 0
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    End Sub
     
    often pressed "F8" key, watch windows shows that ,I successfully reached at
    (for Advance filter , as per rule, require criteria as range format
    so below line put heading for criteria on firstly opened database file's cell "BB1" successfully.)
    Code (vb):

    ActiveSheet.range("BB1").Value = "material"
     
    I stuck on just next line.
    Code (vb):
    ActiveSheet.range("BB2").Value = wkbdest.range("list").Value
    don't know how to do this..& its clearly show that I can stop on every next line till get success..

    Please Help.

    regards,
    Chirag Raval
  12. Marc L

    Marc L Excel Ninja

    Messages:
    3,695
    Read again my post as it's clearly not what I've advised ‼ :confused:
  13. Chirag R Raval

    Chirag R Raval Member

    Messages:
    505
    Dear Sir @Marc L ,

    Sorry I will change it as
    "Application.Match" ..its okay now.

    But please guide as per attached image..
    if named range "list" have more then 1 queried items ? how code can behave?

    my above code successfully open source data & also retrieve column No. from Application.Match function (How to use this column number in advance filter?)

    I can not do advance filter as per attached image

    [​IMG]

    Regards,
    Chirag Raval
    Last edited: Dec 2, 2017
  14. Chirag R Raval

    Chirag R Raval Member

    Messages:
    505
    Dear Sir,

    if on source data, if whole database convert in Table then its made very easy for
    advance filter? but how can we do it?

    Regards,
    Chirag Raval
  15. Chirag R Raval

    Chirag R Raval Member

    Messages:
    505
    Dear Sir @Marc L & Respected all Experts,

    Attached screen shot of error when list provided as criteria to advance filter.

    [​IMG]

    Please help,

    Regards,
    Chirag Raval
  16. Marc L

    Marc L Excel Ninja

    Messages:
    3,695
    Unclear !

    Error comes from an undeclared object, jusk check within Locals window …

    Advanced filter ? So read post #2 !

    If you think about an advanced filter, try it first manually !
    If it can't work within an Excel worksheet it won't work by code …
    If it works manually, just activate Macro recorder and redo it
    then post the generated code here …
  17. Chirag R Raval

    Chirag R Raval Member

    Messages:
    505
    MULTI CRITERA REQUIREMENT.png Dear Sir,

    If criteria is not simple, more then 1 fields involved with multi conditions
    then need to Advance Filter.

    Matter is
    if criteria copy on each opened file, & advance filter on each list items, result can copy to (fetch) in one file (attached screen shot)

    Regards,
    Chirag Raval
  18. Marc L

    Marc L Excel Ninja

    Messages:
    3,695


    So manually your advanced filter works or not ? (post #16 …)
  19. Chirag R Raval

    Chirag R Raval Member

    Messages:
    505
    Dear Sir @Marc L ,

    Oh how can I steal some time from my constantconstant endless work for
    Which I eagrly waiting to get solution of this record fetching requirement.really feel
    Sorrow & some frustrate because to learn VBA require deep concentration & efforts
    Which require some time without disturbance.

    I will be present my recorded macro soon.

    Thanks for your invaluable support.

    Regards,

    Chirag Raval
  20. Chirag R Raval

    Chirag R Raval Member

    Messages:
    505
  21. Chirag R Raval

    Chirag R Raval Member

    Messages:
    505
    Dear All,

    Really I can not do this

    (1) loop all files in particular folder ,
    (2) loop all sheets of every opened files
    (3) on first sheet, filter in place for 1 row of multiple criteria row through advanced filter (only 1 line criteria can be filter at 1 time is this true?)
    (4) copy that filtered block in master sheet
    (5) re-filter same database for 2nd line criteria row & copy to master sheet
    (6) process this till end of criteria on that sheet
    (7) do this for all sheet in that file & close.
    (8) do this for all files -open-filter-copy to master

    how many nested loops involve in this process? I don't know how to structure that..

    I request you to help in my above code..

    Regards,
    Chirag Raval
  22. Chirag R Raval

    Chirag R Raval Member

    Messages:
    505
    Dear All Experts & Dear Sir @Marc L ,

    All files in folder have trusted database is in only
    Sheet no 1 so for every file's first sheet only need to
    Be target , not all sheets of that file
    we can dismiss sheets .

    So Just need to copy criteria block From newly created unsaved master sheet (where
    We need data to be paste, ) on every source file' s first sheet only for advance filter on
    That sheet.

    Hope little help to complete this thread.

    Regards,

    Chirag Raval
  23. Chirag R Raval

    Chirag R Raval Member

    Messages:
    505
    Dear All & @NARAYANK991

    surprisingly this is just reverse engineering of successful code ..(helped from mr @Narayank on..

    https://www.chandoo.org/forum/threa...ate-each-filtered-instance-as-new-file.36314/

    This thread extract & separate from master file ,copy filtered instance in new file .

    But my this thread's requirement is just reverse of above ...it should open each database files in particular folder, filter only on first sheet

    (must be need to copy criteria block on every first sheet , on source file? or criteria block directly taken via code from master sheet on where need to copied data I don't know..) , copy each filtered instance (about 5 column criteria, with multi condition on every row) in newly created unsaved blank workbook....so we can save & do further on that data....just it.

    hope there are some code help available there..

    Regards,
    Chirag Raval
  24. Chirag R Raval

    Chirag R Raval Member

    Messages:
    505
    Dear All Experts,


    Below Modified code not working properly..
    where to "Wend", Where to "Next rw, " just confusing ...

    Code (vb):


    'Testofadvfiltcopyinmaster
    'LOOP IN FILES AND ADVANCE FILTER AND COPY TIO MASTER SHEET

    Sub Test_of_Advfilt_Copy_in_Master()

        Dim file As Variant
        Dim path As String
        Dim i As Integer
        Dim wkbdest As Workbook
        Dim wbksrs As Workbook
        Dim Lastrow As Long
           
    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     ' SET Which workbook Become Active & which will be open in Furutre
     'Activate New, Unsaved , This Worbook & Will Be Use For Furute Re-activate It
    '
     Dim wkb As Workbook
        For Each wkb In Workbooks
            If Left(wkb.Name, 4) = "Book" Then
                Set wkbdest = wkb
            Else
                Exit For
            End If
            wkb.Activate
            Next
    '+++++++++++++++++++++++++++++++++++++++++++++++++++++
       Application.DisplayAlerts = False
        Application.ScreenUpdating = False
    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++
       i = 2
        path = ActiveSheet.range("a2").Value
        If Right(path, 1) <> "\" Then path = path & "\"
        file = Dir(path & "*.xls*")
       
    '+++++++++++++++++++++++++++++++++++++++++++++++++++++++
       ActiveSheet.range("V1:AL5").copy
        While (file <> "")
        For Each file In wkbdest.Sheets(1).range("a2")
        If Error Then GoTo SkipFile
    '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
       Workbooks.Open path & file
        Set wkbsrc = ActiveWorkbook
        '
    '++++++++++++++++++++++++++++++++++++++++++++++
    'REQUIRE:- Advanced Filter here
    Sheets(1).Activate
    ActiveSheet.range("BB1").Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.range("BB1").Select
    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    'Advance filter on multiple critera here
       Dim lrow As Long
    '    Dim I As Integer
       Dim criteriarows As Long
        Dim inputdatarange As range
        Dim criteria_range As range
        Dim rw As range
        Dim criteria_header As range
        Dim crange As range
        Dim criteria As New Collection
       
     
        With ActiveWorkbook.Sheets(1)
            lrow = .Cells(Rows.count, 1).End(xlUp).Row
            Set inputdatarange = .range("A1:AY" & lrow)
            criteriarows = .range("BB" & Rows.count).End(xlUp).Row
            Set criteria_range = .range("BB2:BB" & criteriarows).Resize(, 5)
            Set crange = .range("BN1:BN2").Resize(, 5)
        End With
        Columns.AutoFit
     
        For Each rw In criteria_range.Rows
        If Error Then GoTo Skiprw
            crange.Cells(2, 1).Resize(, 5) = rw.Value
            inputdatarange.AdvancedFilter Action:=xlFilterInPlace, criteriarange:=crange, Unique:=False
            ActiveWorkbook.Sheets("Sheet1").range("A1:AY" & lrow).copy
    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    wkb.Activate
    Sheets(1).Activate
    With ActiveSheet
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            Lastrow = .Cells.Find(What:="*", _
                          After:=.range("A1"), _
                          LookAt:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
                          End If
                          End With
                    ActiveSheet.Rows(Lastrow).Cells(2, 1).Select
                    ActiveSheet.Paste
    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
           wkbsrc.Activate
        Next rw
    'End Sub
    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    'Skiprw:
    '      Next rw
    '
    '    Set wkbdest = Nothing
    '    Set wbksrs = Nothing
    '
    ' ActiveWorkbook.Close
    '      file = Dir()
    '      Wend
    'SkipFile:
    '            Next file
    Wend
    On Error GoTo 0
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    End Sub
     
    After hard work on above this code.. I really tired.. in starting its wok till just copy filtered range...(cut copy mode not off) of active sheet...just it...

    Request to throw little focus after just check it. that where I made mistake to complete this code?

    hope

    Regards,
    Chirag Raval
  25. Marc L

    Marc L Excel Ninja

    Messages:
    3,695

    As you do not let us any chance to test your code (see forum rules) …

    So the smart way is to ask a question
    only for a particular technical point with details.
    It's far better to progress step by step …

Share This Page