• 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

Why LookIn := xlFormulas ?
Check value of LastRow variable : good or wrong ?

If good try before Paste codeline : Cells(LastRow + 1, 1).Select ...


As within your own past threads, you can replace all this stuff by only
Cells(Rows.Count, 1).End(xlUp)(2).Select !

And you can avoid Select & Paste codelines (bad habit)
just directly using Range.Copy method (see VBA inner help) ...
 
Dear Sir,

On destination sheet,Need to copy below dynamic range of structured criteria range
which have about 6 columns.

Which columns rows is more then other its not fixed (Dynemic).

Below this dynemic range on destination file, 1 blank row require,

Below this blank row on destination sheet , copy one time header row copy from first open source file.

Then below this header row on destination sheet, result of first filtered range on source file need to copy-paste.

Now below this every other filtered range should be copy-paste.

Hope I can described well this requirement.

Regards,

Chirag Raval
 
Dear Sirs,

Good news
Code now working ...I am written this by phone so when I on pc in my office I will post it soon .
But just 1 irritated matter involved that data paste with/ including header row....means if 12 files open, filter and paste in destination
Sheet with every file header row also..how to handle this matter?

If there will be put if condition that checks that if , on ,ndestination sheet's cell ("A15") have word
"Customer" then first line of clipboard should not paste.

Can this checks is ok or not good or inefficient process?

If this check necessary. Then how to construct?

Regards,

Chirag Raval
 
Dear Sir,

here is code to prepare structure of criteria in current open new file .
(contains some content from recorded macro)

Code:
Sub Stg_InvInfo_MultiCritStructure()
With ActiveWorkbook.ActiveSheet
    .range("I1").FormulaR1C1 = "Customer"
    .range("J1").FormulaR1C1 = "Inv. Date"
    .range("K1").FormulaR1C1 = "Inv. Date"
    .range("L1").FormulaR1C1 = "Sal Doc Ty"
    .range("M1").FormulaR1C1 = "Material"
    .range("I2").FormulaR1C1 = ">=0"
    .range("J2").FormulaR1C1 = "="">""& DATEVALUE(""01-01-2017"")"
    .range("K2").FormulaR1C1 = "=""<""& DATEVALUE(""31-12-2017"")"
    .range("L2").FormulaR1C1 = "YBKG"
    .range("M2").FormulaR1C1 = "005384-0008"
  .range("I1:M5").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    End With
    Cells.EntireColumn.AutoFit
    range("I1:M5").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With ActiveSheet
   
    range("I1:M1").Select
    Selection.Font.Bold = True
    range("I1:M5").Select
    Selection.Copy
    range("P1").Select
    ActiveSheet.Paste
   
      Application.CutCopyMode = False
    Cells.Select
    Cells.EntireColumn.AutoFit
    range("I1").Select
   
     
    range("P2:T5").Cells.ClearContents
    range("P3:T5").Cells.ClearFormats
   
    range("A2").Value = "D:\INV INFO 46 COLUMNS ALL GUJARAT-MONTH WISE EXCEL FILE-2017"
    range("A4").Value = "YOU CAN SEE RESULT IN NEXT SHEET"
   
    With ActiveSheet.range("A4")
   
    .Font.Bold = True
    .Font.Size = "16"
       
End With
  
    End With
End Sub

critera structure.jpg
 
Dear All,

Here is working code for fetching data from file

must note that heading of files must be match with criteria heading .

Code:
Option Explicit
'Testofadvfiltcopyinmaster
'LOOP IN FILES AND ADVANCE FILTER AND COPY TIO MASTER SHEET FOR SUITING INVOICE INFORMATION

'WARNING :- FIRST RUN READY MADE CRITERA MACRO FOR READY MADE CRITERA STRUCTURE

'SUITING INVOICE INFORMATION
Sub StgLoopFileAdvfilt_CopyinMaster()

  
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
  
'    Set wkbDest = ThisWorkbook
    Set wkbDest = ActiveWorkbook
  
    Dim LastRow As Long
    Dim StrMyPath As String
    StrMyPath = ActiveSheet.range("A2").Value 'change folder path to suit your needs
  
    Dim strFileAndExt As String
  
'    StrMyPath = ActiveSheet.range("A2").text 'change folder path to suit your needs
'    StrMyPath = "D:\INV INFO 46 COLUMNS ALL GUJARAT-MONTH WISE EXCEL FILE-2017" 'change folder path to suit your needs
    If Right(StrMyPath, 1) <> "\" Then
        StrMyPath = StrMyPath & "\"
    End If
  
    Application.ScreenUpdating = False
    Application.EnableEvents = False
  
    
    ChDir StrMyPath
  
    strFileAndExt = Dir(StrMyPath & "*.xl*")
      
    Do While strFileAndExt <> ""
  
    '    Set wkbDest = ThisWorkbook
    Set wkbDest = ActiveWorkbook
    wkbDest.Activate
  
    ActiveSheet.range("I1:T5").Copy
  
        Set wkbSource = Workbooks.Open(StrMyPath & strFileAndExt)
      
'        Application.Wait Now + TimeValue("00:00:01") 'FILE KHULE TYAN SUDHI RAAH JOSE

'        DoEvents 'Ensure Workbook has opened before moving on to next line of code
      
        On Error GoTo Skip

        With wkbSource
'
        Sheets(1).Activate
  
''++++++++++++++++++++++++++++++++++++++++++++++
'REQUIRE:- Advanced Filter here
ActiveSheet.range("BN1").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.range("BN1").Select
End With
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'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 Variant
    Dim criteria_header As range
    Dim crange As range
    Dim criteria As New Collection
  
  
    With ActiveWorkbook.Sheets(1)
    If .AutoFilterMode Then .Cells.AutoFilter
        lRow = .Cells(Rows.count, 1).End(xlUp).Row
        Set inputdatarange = .range("A1:BL" & lRow)
        criteriarows = .range("BN" & Rows.count).End(xlUp).Row
        Set criteria_range = .range("BN2:BN" & criteriarows).Resize(, 5)
        Set crange = .range("BU1:BU2").Resize(, 5)
    End With
  
    On Error GoTo Skip
    For Each rw In criteria_range.Rows
        crange.Cells(2, 1).Resize(, 5) = rw.Value
        inputdatarange.AdvancedFilter Action:=xlFilterInPlace, criteriarange:=crange, Unique:=False
'        ActiveWorkbook.Sheets("Sheet1").range("A2:A" & lRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy
        ActiveWorkbook.Sheets(1).range("A1:BL" & lRow).Copy
                        
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
wkbDest.Activate

Sheets(2).Activate
With ActiveSheet


range("A1").Select
    Selection.End(xlDown).offset(1, 0).Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

End With
              
                Application.CutCopyMode = False
              
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        wkbSource.Activate
    Next rw
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Skip:
Resume Next
'Next wkbSource
Resume Next
'End With
wkbSource.Close SaveChanges:=False


DoEvents
' Application.Wait Now + TimeValue("00:00:01")
'Get next file name
      strFileAndExt = Dir
    
    Set wkbDest = Nothing
    Set wkbSource = Nothing
Loop
'
Cells.WrapText = False
Cells.EntireColumn.AutoFit
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
Dear All Experts,

Can it Will as below (in normal language)?

If destination sheet"s range "A15" have word "Customer" then activate source workbook & copy range (all filtered rows ,whis is below row (1) in other words copy all rowsr below header row,) & to do this use offset property, offset (1) .& reactivate destination sheet and paste all copied rows at data end..to do thise on detination sheet ) use .End(xlUp).offset(1)

Please suggest .am I right?

Chirag Raval
 
Dear Sir,

thanks for your support till now....

below is for minimise time for advance filter on all files of folder...
if target set based on condition ...then only required files can be process...

Please help for conditional loop over multi folder as per start period to end period mentioned in criteria...I attached my requirement here with my folder structure & file name start for month number.
ONLY THOS FILES.jpg


below is folder structure...

MAIN FOLDER & SUBFOLDER.jpg


if my criteria have "01-07-2017" then focus should (for file retrieving)
be on folder named "2017", if my criteria range have "15-01-2018 " automatic files retrieve from folder named "2018"

how can we setup this?

Regards,

Chiag Raval
 
Last edited:
Dear Sirs,

Now little time i got for overview on my problem...
this is really effactive & necessary situation to choose right folders & right files in it to process......i really can not
construct this situation in code..

(1) I Have 2 folders (2017 & 2018),may be more in future

(2) Each folder have month wise file , name start on month number like
for file of Jan-17 filename start from "01" , for feb file name start
from "02" (naturally all file of 2017) so 01 to 12 files for each month in
named 2017 folder , same situation in folder named 2018..

(3) on active sheet there are 2 fixed locations (under column "Z" as start
looking from date & under column "AA" for till Looking date ) as
folders from where data shoukld need to be fetch
.
(4) We can understand concept that core loop , 1st loop start based on 1st
row of critera (For Each Row ...Loop untill blank critera row or Last
Critera Row)

(5) 2nd inner loop start looking for storing folder names in array , which already obtained folder Named base on year
"From Date" to "To Date" mentioned in critera row and based on that Array store in it self (Lbound From year to Ubound
to year ).

(6) After 2nd loop ,start 3rd loop for store file names based on folder names stored in preious array (folder array) & store all file names from all folders on first array

(7) Now each file opend as per dir function , fethch data, close it, same process on nex open arrayed elimented file, close it. (if critera in between 2 yeas , then naturally first array have all that folder names & based oh that 2nd array have all file from all folders in first array) ....process all files .

(3) loop stop & end Su after fetch data after process all arrayed folders, all
arrayed files.

how can we construct this 3 situations in code?

please help..

Regards,

Chirag Raval
 
Any situation could be built only if Logic is respected …

As I can't guess to determine any, take only one situation,
post the code part relative to this situation, crystal clear explain the need
and the difficulty encountered, with maximum details, …

Without any valid logic, any detail, any code started,
don't expect codelines but just a general guide line.
 
Dear Sirs,

Thanks for your reply...

Actually we want to procesas on " Objects" (Target is file Objects , resides in Folder Objects) .

But condition is "not to process all Objects" , we want to process only those objecta which we want (month & year level basic
conditions written in some fixed cells).
if want to do that mannually, we can not complete process in one shot or one try in mannual process. then there are not need
to VBA,

But we want Automation in this repeated task through VBA.
in VBA ,we can not directly catch that objects as just mouse clicks.

first we should create variable that can store "reference" as just "Names of real objects" , not actula objects,,,varable
type should be "String" to store that names & then use this name to access that real objects..

"Collection" is for objects only & "Array" contain strings only...

Names, stored in array variable , this Reference use to access Objects stored in collection.

"For Each loop..can loop on both ..On Each Arrayed Element & also Collection's Each Objects..

so there re need to create another variable that can stores real object
that called "Collection"

so there are need actually 3 " nested For Each...Loop" construct.

(1) For Each critera row
(2) For Each to store folde Name , Stored in array (lbound First Folder name to Ubound Last Folder Name
(3) For Each oBbjects stored in Collection (Naturally which objects?
require name of object here which obtained from based first arrayed variable in which all names )

now confuson is that so in this process how to construct array & collection?
Dir function take only one matter/ case in one time..it can not automate
on one by one folders/files autometially..there need more construct to create this
code situation..

Regards,
Chirag Raval
 
As common solution does not store any object … (RAM waste !)
As Dir results are not objects …
As I never had the need to use any collection to just copy data …
So I won't follow this way until you show your work and your analyse.

And do not forget Macro recorder offering a free code base …
 
Dear Sir,

Thanks for your reply,

But really I can not inherit this in my code...even I try to record macro but
there are just simple advance filter & hard coded single path displayed..
how to modify below portion of code?

Code:
Sub StgLoopFileAdvfilt_CopyinMaster()
 
   
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
   
'    Set wkbDest = ThisWorkbook
     Set wkbDest = ActiveWorkbook
   
    Dim lastrow As Long
    Dim StrMyPath As String
    StrMyPath = ActiveSheet.range("A2").Value 'change folder path to suit your needs
   
    Dim strFileAndExt As String
   
'    StrMyPath = ActiveSheet.range("A2").text 'change folder path to suit your needs
'    StrMyPath = "D:\INV INFO 46 COLUMNS ALL GUJARAT-MONTH WISE EXCEL FILE-2017" 'change folder path to suit your needs
    If Right(StrMyPath, 1) <> "\" Then
        StrMyPath = StrMyPath & "\"
    End If
   
    Application.ScreenUpdating = False
    Application.EnableEvents = False
   
     
    ChDir StrMyPath
   
    strFileAndExt = Dir(StrMyPath & "*.xl*")
       
    Do While strFileAndExt <> ""
   
    '    Set wkbDest = ThisWorkbook
    Set wkbDest = ActiveWorkbook
    wkbDest.Activate
   
    ActiveSheet.range("I1:T5").Copy
   
        Set wkbSource = Workbooks.Open(StrMyPath & strFileAndExt)
       
'        Application.Wait Now + TimeValue("00:00:01")

'        DoEvents 'Ensure Workbook has opened before moving on to next line of code
       
        On Error GoTo Skip

        With wkbSource
'
        Sheets(1).Activate

hope your help.

Regards,
Chirag Raval
 
You can modify your code directly in VB Editor,
all I can say 'cause we are not on a mind reader forum
so without a crystal clear explanation as yet asked several times …

At least activate Macro Recorder, operate manually
then post the generated code here and E X P L A I N your need.

« If you can’t explain it simply, you don’t understand it well enough … »
Albert Einstein
 
Dear Sirs,

This thread meet solution of " loop all files in particular folder" that already do its job till now..

Can I start new thread because now requirement change...(require more precise)
Not loop on all folders, files but some specific folders , sub folders & only required files ( not all files)
Base on given period.

Please suggest for start new thread..

Regards,

Chirag Raval
 

Yes, start a new one and yes, be more precise as you can !

No need for a novel, just explain global need
then present a technical point where you're stuck …
Once a point is solved, present next one.
Of course with an attachment before (/ after if needed) …
 
Back
Top