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.

 

[mumps]

What makes the cell in the line of the specific sheet equal to TRUE? Are you looking for a specific value in a particular column? For example, are you looking for a specific word such as "Yes" in column D and if "Yes" exists in column D then copy that entire row to the destination file? Do you want to look in all the worksheets in each file or only one sheet? What are the names of the source sheets? What is the extension of the source files (xls, xlsx, xlsm)? What is the full path to the folder containing the source files?

 

[Michael1984DK]

Hi.

Thank you for fast reply.

The "open all files within a selcted folder" script is already in place, I would say:

Sub LoopAllExcelFilesInFolder()


Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog


'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual


'Retrieve Target Folder Path From User
  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


'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings


'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"


'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)


'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)
    
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
    
    'PUT IN THE BATCH SCRIPT FOR EACH FILE HERE....
      XXXXXXXXXXXXXXXXXXXXXXXX
    
    'Save and Close Workbook
      wb.Close SaveChanges:=True
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents


    'Get next file name
      myFile = Dir
  Loop


'Message Box when tasks are completed
  MsgBox "Task Complete!"


ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True


End Sub

When I run this script it will ask for the path and run through the XLS* files one by one, running the "job" in each of them.

The IF could be something like: =IF(A:A<>"";COPY SCRIPT AND MOVE TO NEXT LINE;IGNORE AND MOVE TO NEXT LINE SCRIPT)

So if cell A1="", go to A2.. etc... Up to maybe A150 to save processing time (wont be anything above here).
I could make it so that if there is anything to be copied (not just anything but relevant to copy), the A column will have an autofilled "OK" or something based on the line.

Let me know if it is still unclear what I mean.

Thank you

 

[mumps]

You want to copy the entire row if the cell in column A is blank. Is this correct? I will still need to know the name of the sheet in each file from which you want to copy and the name of the sheet to which you want to paste the rows.

 

[Michael1984DK]

Well. Actually the other way around. Copy if not empty.

The source sheets are all called "Overview".

The target sheet is called "Summary".

I have been looking around online and found several pieces of code that might be put together to make this work, but my VBA skills are still rather green, so I am not sure i can do this.

I assume that it is important that formatting is exactly the same in all source files (no merging etc.)? The source files are assorted future sales campaigns, that I will need to gather for reporting. So far I am doing this one by one (copying, lets say row 6 to row 25-40, into a summary workbook for further reporting). This is very time consuming each month, so I would like to automate this process as much as possible, so I will have more time to look at the numbers instead.

 

[Michael1984DK]

It seems that this code I found actually kind of does the job, just need to add the "IF(A*="";"";Copy)" and the specific target workbook and sheet:

Option Explicit
Sub CombineDataFiles()


Dim DataBook As Workbook, OutBook As Workbook
Dim DataSheet As Worksheet, OutSheet As Worksheet
Dim TargetFiles As FileDialog
Dim MaxNumberFiles As Long, FileIdx As Long, _
    LastDataRow As Long, LastDataCol As Long, _
    HeaderRow As Long, LastOutRow As Long
Dim DataRng As Range, OutRng As Range


'initialize constants
MaxNumberFiles = 2001
HeaderRow = 1 'assume headers are always in row 1
LastOutRow = 1


'prompt user to select files
Set TargetFiles = Application.FileDialog(msoFileDialogOpen)
With TargetFiles
    .AllowMultiSelect = True
    .Title = "Multi-select target data files:"
    .ButtonName = ""
    .Filters.Clear
    .Filters.Add ".xlsx files", "*.xlsx"
    .Show
End With


'error trap - don't allow user to pick more than 2000 files
If TargetFiles.SelectedItems.Count > MaxNumberFiles Then
    MsgBox ("Too many files selected, please pick more than " & MaxNumberFiles & ". Exiting sub...")
    Exit Sub
End If


'set up the output workbook
Set OutBook = Workbooks.Add
Set OutSheet = OutBook.Sheets(1)


'loop through all files
For FileIdx = 1 To TargetFiles.SelectedItems.Count


    'open the file and assign the workbook/worksheet
    Set DataBook = Workbooks.Open(TargetFiles.SelectedItems(FileIdx))
    Set DataSheet = DataBook.ActiveSheet


    'identify row/column boundaries
    LastDataRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LastDataCol = DataSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column


    'if this is the first go-round, include the header
    If FileIdx = 1 Then
        Set DataRng = Range(DataSheet.Cells(HeaderRow, 1), DataSheet.Cells(LastDataRow, LastDataCol))
        Set OutRng = Range(OutSheet.Cells(HeaderRow, 1), OutSheet.Cells(LastDataRow, LastDataCol))
    'if this is NOT the first go-round, then skip the header
    Else
        Set DataRng = Range(DataSheet.Cells(HeaderRow + 1, 1), DataSheet.Cells(LastDataRow, LastDataCol))
        Set OutRng = Range(OutSheet.Cells(LastOutRow + 1, 1), OutSheet.Cells(LastOutRow + 1 + LastDataRow, LastDataCol))
    End If


    'copy the data to the outbook
    DataRng.Copy OutRng


    'close the data book without saving
    DataBook.Close False


    'update the last outbook row
    LastOutRow = OutSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row


Next FileIdx


'let the user know we're done!
MsgBox ("Combined " & TargetFiles.SelectedItems.Count & " files!")


End Sub

 

[mumps]

Try:

Sub LoopAllExcelFilesInFolder()
    Dim wbSrc As Workbook
    Dim shDes As Worksheet
    Set shDes = ThisWorkbook.Sheets("Summary")
    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(shDes.Rows.Count, "A").End(xlUp).Offset(1, 0)
        wbSrc.Close SaveChanges:=False
        myFile = Dir
    Loop
    MsgBox "Task Complete!"
ResetSettings:
    Application .EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

 

[Michael1984DK]

Hi again.

First of all, thank you so much for your help on this and your fast replies!! I need to learn alot in this I see.

I am getting the following error when running script:

Compile error: Invalid or unqualified reference and then line 9 is highlighted:

Application .EnableEvents = False

Am I doing something wrong?

 

[Michael1984DK]

Ahh, It was just a space that needed to be removed. It is working, but copying the source files on top of each other, so they dont get copied in below each other.

 

[mumps]

I tried it on some dummy files and it worked properly. Are there any blank cells in any of the other columns besides those in column A?