Combining lines from several files within folder via IF or similar

[Michael1984DK]

Hi.

I have a need to make a script, that opens and looks through all files within a selected folder. In each file, it should look for a certain IF sentence. If the cell in the line of the specific file = TRUE, it should copy these lines to a new file. The idea is to add and collect all the "valid" lines into one file in continued order (so copy to first empty line or where cell x = "").

I already have a VBA script, that opens each file with a user selected folder, but I am not sure how to do the last part for each file (the action itself).

I think it would be easiest to have a "summary file" containing the "open all files and do action" script within. This should also be the file to copy the valid lines from the other files into.

Ex:
File 1:
No
No
No
Yes - Copy to summary in first empty line
Yes - Copy to summary in first empty line
No
Yes - Copy to summary in first empty line

File 2:
Yes - Copy to summary in first empty line
Yes - Copy to summary in first empty line
No
No
Yes - Copy to summary in first empty line
No

Summary..
Yes (from file 1 line 4)
Yes (from file 1 line 5)
Yes (from file 1 line 7)
Yes (from file 2 line 1)
Yes (from file 2 line 2)
Yes (from file 2 line 4)

Does this make sense and can it be done somehow?

Thank you.

 

[Michael1984DK]

Hi again.

Yes, there might be on some of them.

I need to pull the "good" lines, Column A to Column Q, but columns C, E, K, N and P might be empty (differs from file to file). Is this what is causing the "error"?

 

[mumps]

Try:

Sub LoopAllExcelFilesInFolder()
    Dim wbSrc As Workbook
    Dim shDes As Worksheet
    Set shDes = ThisWorkbook.Sheets("Summary")
    Dim LastRow As Long
    LastRow = 1
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog
    Application .EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With
NextCode:
    myPath = myPath
    If myPath = "" Then GoTo ResetSettings
    myExtension = "*.xls*"
    myFile = Dir(myPath & myExtension)
    Do While myFile <> ""
        Set wbSrc = Workbooks.Open(Filename:=myPath & myFile)
        On Error Resume Next
        Sheets("Overview").Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        Sheets("Overview").UsedRange.Copy shDes.Cells(LastRow, 1)
        LastRow = shDes.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
        wbSrc.Close SaveChanges:=False
        myFile = Dir
    Loop
    MsgBox "Task Complete!"
ResetSettings:
    Application .EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

 

[Michael1984DK]

Sorry for late response. I actually didn't see you had replied.

Now it seems to be copying from the first file, with formatting, not as values, so the formula cells from the file are now #REF ! instead. Can I change it to paste as values instead?

It doesn't seem to be going on to the next file though. On the plus side, it only takes the lines from "file 1" that has data in column A cells.

Thank you

 

[Michael1984DK]

Sidenote.. How did you learn how to do all this? I am really trying to read and understand the code, but there is just so many strange words in between.
Is everything in "blue" fixed VBA code terms and everything black manually selected and could be anything as long as the links building up to them is correct?

I am very eager to learn how to do this myself for future similar needs.

 

[mumps]

This macro will paste the values only. I don't know why the macro isn't looping through all the files. I tested it on some dummy files and it worked properly. Give it another try.

Sub LoopAllExcelFilesInFolder()
    Dim wbSrc As Workbook
    Dim shDes As Worksheet
    Set shDes = ThisWorkbook.Sheets("Summary")
    Dim LastRow As Long
    LastRow = 1
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With
NextCode:
    myPath = myPath
    If myPath = "" Then GoTo ResetSettings
    myExtension = "*.xls*"
    myFile = Dir(myPath & myExtension)
    Do While myFile <> ""
        Set wbSrc = Workbooks.Open(Filename:=myPath & myFile)
        On Error Resume Next
        Sheets("Overview").Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        Sheets("Overview").UsedRange.Copy
        shDes.Cells(LastRow, 1).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        LastRow = shDes.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
        wbSrc.Close SaveChanges:=False
        myFile = Dir
    Loop
    MsgBox "Task Complete!"
ResetSettings:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

 

[mumps]

If you are interested in learning VBA, the very first thread (highlighted in blue) in this Forum is a good place to start. This link from hiker95, should also prove to be valuable: https://www.mrexcel.com/forum/excel...e-template-excel-spreadsheet.html#post4972842

 

[Michael1984DK]

Wonderful. I will have a deep look at it.

The formatting and paste special works now, so it shows the correct things in Summary sheet, for file 1. I see in the windows menu line, that it opens and closes a lot of excel files when running, but it still doesn't copy anything from the other files. Is there anything I can do to show you why it might not be copying it?

 

[mumps]

Do all the files have a sheet named "Overview" which contains the data to be copied?

 

[Michael1984DK]

Yes, just checked all of them (8 in this case). It is sheet number 1 in all files, if that could be used too.

 

[mumps]

If they are named "Overview", the macro should work. Could you upload 2 or 3 of the files that aren't being copied to a free site such as www.box.com or www.dropbox.com. Once you do that, mark each file for 'Sharing' and you will be given a link to each file that you can post here. If the workbook contains confidential information, you could replace it with generic data.