• 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...

  • 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

C

Chirag R Raval

Member
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
 
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 …
​
 
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: 
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
 
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 …
​
 

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

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

Code: 
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
 

• 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.
​
 
Dear Sir @Marc L ,

Thanks ,
I applied as per your guidelines
(1) .."Application.worksheetfunction"
Code: 
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: 
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: 
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: 
ActiveSheet.range("BB1").Value = "material"

I stuck on just next line.
Code: 
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
 
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



Regards,
Chirag Raval
 
Last edited:
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
 
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 …
​
 
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
 
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
 
Chirag R Raval said:
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
Click to expand...
 
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
 
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
 
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
 
Dear All Experts,


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

Code: 
'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
 

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 …
​
 
You must log in or register to reply here.
Back
Top