Repeating Macro On Multiple Files In Order

[CVBALeo]

Hi!
First post here but I'm sure it wont be my last as automating results analysis in Excel is making my life 100000000x easier.

I'm not a complete novice with VBA but FAR from an expert with it.

I would really appriciate some help with the following. I'm trying to repeat a macro that opens a txt file, imports the data as comma delimited then copies to a specific sheet (RawData) in a known workbook/the main workbook. It needs to copy each set of data to the next empty cell in column A, starting at A1. This needs to be repeated for the amount of files selected initially in a dialogue box - it's usually no more than ten but sometimes less than that.

My current issues are:

• I'm just repeating the same code again and again for the amount of files I want to process inside one sub - this means changing the code for different amounts of files
• I can't seem to get the first set of copied data into A1 using the same code for dataset 2 onwards. So I currently have code for dataset 1, then different, repeating code for dataset 2 onwards
• The code is taken from here and there and recorded user input so is probably more long winded than it needs to be.
• I cant seem to close down all the text files that get opened to copy data from as the With function to move to next empty cell in coloumn A ends up breaking/getting an error.

The code for dataset 1 and dataset 2 (which is then just repeated another eight times = 10 datasets in total):

Sub ImportData()


'Delete All Current Data in RawData Sheet and load number One Data


    Dim txtFileNameAndPath As String
    Dim ImportingFileName As String
    Dim SheetName As Worksheet
    Dim fd As Office.FileDialog
    Dim MainWB As String
        MainWB = ActiveWorkbook.Name
    Dim lst As Long
    
                
    'Speeds Up Processing
    Application.ScreenUpdating = False
    'Suppresses Clipboard Prompt
    Application.DisplayAlerts = False
    
    'Deletes all data from RawData Sheet
    Sheets("RawData").Select
    Range("A1:I1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
 
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
 
    With fd
        'Enable this option if you want the use to be able to select multiple files
        .AllowMultiSelect = False
        'This sets the title of the dialog box.
        .Title = "Please select number One Data file"
 
        'Sets the associated filters for types of files
        .Filters.Clear
        .Filters.Add "TXT", "*.TXT"
        .Filters.Add "All Files", "*.*"
 
        ' Show the dialog box. If the .Show method returns True, the
        ' user picked at least one file. If the .Show method returns
        ' False, the user clicked Cancel.
        If .Show = True Then
          txtFileNameAndPath = .SelectedItems(1)
        Else
            MsgBox "Please start over.  You must select a .txt file to import."
            'You don't want the sub continuing if there wasn't a file selected
            Exit Sub
        End If
    End With
 
    'Extracts only the file name for reference later
    ImportingFileName = Right(txtFileNameAndPath, _
        Len(txtFileNameAndPath) - InStrRev(txtFileNameAndPath, "\"))
        
    'Loads in user selected workbook from dialog box and sets it to delimited, space seperated data
    Workbooks.OpenText Filename:=ImportingFileName _
        , Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1)), TrailingMinusNumbers:=True
    'Selects full range of data to be copied
    Range("A1:I1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    'ActiveWorkbook.Close
    Windows(MainWB).Activate
    Sheets("RawData").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    
'Load ESS Cycle Two Data
   
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
 
    With fd
        'Enable this option if you want the use to be able to select multiple files
        .AllowMultiSelect = False
        'This sets the title of the dialog box.
        .Title = "Please select number Two Data file"
 
        'Sets the associated filters for types of files
        .Filters.Clear
        .Filters.Add "TXT", "*.TXT"
        .Filters.Add "All Files", "*.*"
 
        ' Show the dialog box. If the .Show method returns True, the
        ' user picked at least one file. If the .Show method returns
        ' False, the user clicked Cancel.
        If .Show = True Then
          txtFileNameAndPath = .SelectedItems(1)
        Else
            MsgBox "Please start over.  You must select a .txt file to import."
            'You don't want the sub continuing if there wasn't a file selected
            Exit Sub
        End If
    End With
 
    'Extracts only the file name for reference later
    ImportingFileName = Right(txtFileNameAndPath, _
        Len(txtFileNameAndPath) - InStrRev(txtFileNameAndPath, "\"))
        
    'Loads in user selected workbook from dialog box and sets it to delimited, space seperated data
    Workbooks.OpenText Filename:=ImportingFileName _
        , Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1)), TrailingMinusNumbers:=True
    'Selects full range of data to be copied
    Range("A1:I1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    'ActiveWorkbook.Close
    Windows(MainWB).Activate
    With Sheets("RawData")
        lst = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A" & lst).PasteSpecial xlPasteValues
    End With

End Sub

Thanks in advance!!

Chris

 

[John_w]

Welcome to MrExcel forums. Try this macro:

Sub ImportData()

    Dim txtFileNameAndPath As String
    Dim ImportingFileName As String
    Dim fd As Office.FileDialog
    Dim DataFileNumber As Long, RawDataRow As Long
    Dim MainWb As Workbook
    
    Set MainWb = ActiveWorkbook
    
    'Speeds Up Processing
    Application.ScreenUpdating = False
    'Suppresses Clipboard Prompt
    Application.DisplayAlerts = False
    
    'Deletes all data from RawData Sheet
    Sheets("RawData").Range("A1:I1").CurrentRegion.ClearContents
 
    RawDataRow = 1
    DataFileNumber = 1
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    Do
    
        With fd
            'Enable this option if you want the use to be able to select multiple files
            .AllowMultiSelect = False
            'This sets the title of the dialog box.
            .Title = "Please select number " & DataFileNumber & " Data file"
        
            'Sets the associated filters for types of files
            .Filters.Clear
            .Filters.Add "TXT", "*.TXT"
            .Filters.Add "All Files", "*.*"
        
            ' Show the dialog box. If the .Show method returns True, the
            ' user picked at least one file. If the .Show method returns
            ' False, the user clicked Cancel.
            If .Show = True Then
                txtFileNameAndPath = .SelectedItems(1)
            Else
                txtFileNameAndPath = ""
            End If
        End With
    
        If txtFileNameAndPath <> "" Then
        
            'Extracts only the file name for reference later
            ImportingFileName = Right(txtFileNameAndPath, Len(txtFileNameAndPath) - InStrRev(txtFileNameAndPath, "\"))
            
            'Loads in user selected workbook from dialog box and sets it to delimited, space seperated data
            Workbooks.OpenText Filename:=ImportingFileName _
                    , Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
                    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
                    Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
                    Array(2, 1)), TrailingMinusNumbers:=True
            'Selects full range of data to be copied
            Range("A1:I1").CurrentRegion.Copy MainWb.Worksheets("RawData").Cells(RawDataRow, 1)
            ActiveWorkbook.Close False
            
            With MainWb.Worksheets("RawData")
                RawDataRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            End With
            DataFileNumber = DataFileNumber + 1
            
       End If
    
    Loop While txtFileNameAndPath <> ""
    
End Sub

 

[CVBALeo]

Wow, much more elegant and fixes all the problems I mentioned... I think I actually understand how the changes work too .

One thing though, I had hoped to utilise the .AllowMultiSelect function so that you could just select all the text files you want processing and then let the macro work away until it's done. It's this part of the code I got really stuck on as I couldn't work out how to get excel to remember the list of selected files and then process them which I believe it would need to do?

Thanks again,

Chris

 

[John_w]

This allows multiple files to be selected and imports all of them.

Sub ImportData2()

    Dim MainWb As Workbook
    Dim selectedFiles As FileDialogSelectedItems, textFile As Variant
    Dim RawDataRow As Long
    
    Set MainWb = ActiveWorkbook
    
    'Deletes all data from RawData Sheet
    Sheets("RawData").Range("A1:I1").CurrentRegion.ClearContents
 
    RawDataRow = 1
    
    With Application.FileDialog(msoFileDialogFilePicker)
        'Enable this option if you want the use to be able to select multiple files
        .AllowMultiSelect = True
        'This sets the title of the dialog box.
        .Title = "Please select data file(s)"
        
        'Sets the associated filters for types of files
        .Filters.Clear
        .Filters.Add "TXT", "*.TXT"
        .Filters.Add "All Files", "*.*"
        
        ' Show the dialog box. If the .Show method returns True, the
        ' user picked at least one file. If the .Show method returns
        ' False, the user clicked Cancel.
        Set selectedFiles = Nothing
        If .Show Then Set selectedFiles = .SelectedItems
    End With
   
    If Not selectedFiles Is Nothing Then
    
        'Speeds Up Processing
        Application.ScreenUpdating = False
        'Suppresses Clipboard Prompt
        Application.DisplayAlerts = False
    
        For Each textFile In selectedFiles
        
            Workbooks.OpenText Filename:=textFile, _
                    Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
                    Tab:=True, Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
            Range("A1:I1").CurrentRegion.Copy MainWb.Worksheets("RawData").Cells(RawDataRow, 1)
            ActiveWorkbook.Close False
            
            With MainWb.Worksheets("RawData")
                RawDataRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            End With
                
        Next
    
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
    
    End If

End Sub

 

[CVBALeo]

Brilliant. This is so, so helpful! Thank JohnW ?

 

[CVBALeo]

I'm back!

A follow up to this question/solution as I'm doing something similar with CSV files.

The issues I'm coming up against this time:

• Sections I've labelled ONE and TWO work on their own but this can obviously only be applied to one csv file at a time - it's quite quick but not super quick.
• When I run the full VBA code below, it allows me to select multiple CSV files but I'm not sure it opens then and it also doesnt apply sections ONE and TWO.
• It does however rename and save the workbook the macros are contained as "ProcessingMacro._Processed" which is saved as a _PROCESSED file type (obviously not a thing...).

So ideally, I want to process a CSV files with the code in sections ONE & TWO, create new csv file with "_processed" at the end of the filename, save & close that file and repeat for the all selected files!

Thanks in advance!

Sub AllDataProcess()


'This Macro allows processing Multiple Spec An Results ready for manipulation in AWR MWO
    Dim selectedFiles As FileDialogSelectedItems, csvFile As Variant
    Dim wbNam As String, dt As String

    With Application.FileDialog(msoFileDialogFilePicker)
        'Enable this option if you want the use to be able to select multiple files
        .AllowMultiSelect = True
        'This sets the title of the dialog box.
        .Title = "Please select data file(s)"
        
        'Sets the associated filters for types of files
        .Filters.Clear
        .Filters.Add "CSV", "*.CSV"
        .Filters.Add "All Files", "*.*"
        
        ' Show the dialog box. If the .Show method returns True, the
        ' user picked at least one file. If the .Show method returns
        ' False, the user clicked Cancel.
        Set selectedFiles = Nothing
        If .Show Then Set selectedFiles = .SelectedItems
    End With
   
    If Not selectedFiles Is Nothing Then
    
        'Speeds Up Processing
        Application.ScreenUpdating = False
        'Suppresses Clipboard Prompt
        Application.DisplayAlerts = False
    
        For Each csvFile In selectedFiles
        
        'ONE - This section removes rows 1-45, converts column A to GHz then removes column D data for cleanliness
        Rows("1:45").Select
        Selection.Delete Shift:=xlUp
        ActiveWindow.SmallScroll Down:=-15
        Range("D1").Select
        ActiveCell.FormulaR1C1 = "=RC[-3]/1e9"
        Range("D1").Select
        Selection.AutoFill Destination:=Range("D1:D1001"), Type:=xlFillDefault
        Range("D1:D1001").Select
        Selection.Copy
        Columns("A:A").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Columns("D:D").Select
        Selection.Delete
     
        'TWO - This section removes File extension, adds "_Processed" to end of filename & saves workbook in location it was loaded from.
        wbNam = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
        dt = "_Processed"
        ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & wbNam & dt
        ActiveWorkbook.Close False
                          
        Next
    
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
    
    End If
    
End Sub

 

[John_w]

it's quite quick but not super quick.

Because you're Selecting cells (what the Macro Recorder does) which is slower than addressing them directly. In the macro below I've removed all the Selects and Selections so it should be a bit faster.

allows me to select multiple CSV files but I'm not sure it opens then

It definitely doesn't open them. You need a Workbooks.Open or Workbooks.OpenText statement to open a workbook file.

Try this macro.

Sub AllDataProcess2()

    'This Macro allows processing Multiple Spec An Results ready for manipulation in AWR MWO
    
    Dim selectedFiles As FileDialogSelectedItems, csvFile As Variant
    Dim wbNam As String, dt As String
    Dim lastRow As Long
    
    With Application.FileDialog(msoFileDialogFilePicker)
        'Enable this option if you want the use to be able to select multiple files
        .AllowMultiSelect = True
        'This sets the title of the dialog box.
        .Title = "Please select data file(s)"
        
        'Sets the associated filters for types of files
        .Filters.Clear
        .Filters.Add "CSV", "*.CSV"
        .Filters.Add "All Files", "*.*"
        
        ' Show the dialog box. If the .Show method returns True, the
        ' user picked at least one file. If the .Show method returns
        ' False, the user clicked Cancel.
        Set selectedFiles = Nothing
        If .Show Then Set selectedFiles = .SelectedItems
    End With
   
    If Not selectedFiles Is Nothing Then
    
        'Speeds Up Processing
        Application.ScreenUpdating = False
        'Suppresses Clipboard Prompt
        Application.DisplayAlerts = False
    
        For Each csvFile In selectedFiles
        
            Workbooks.Open csvFile
            
            With ActiveWorkbook
            
                'ONE - This section removes rows 1-45, converts column A to GHz then removes column D data for cleanliness                
                Rows("1:45").Delete Shift:=xlUp
                lastRow = Cells(Rows.Count, "D").End(xlUp).Row
                Range("D1").FormulaR1C1 = "=RC[-3]/1e9"
                Range("D1").AutoFill Destination:=Range("D1:D" & lastRow), Type:=xlFillDefault
                Range("A1:A" & lastRow).Value = Range("D1:D" & lastRow).Value
                Columns("D").Delete
               
                'TWO - This section removes File extension, adds "_Processed" to end of filename & saves workbook in location it was loaded from.
                .SaveAs Filename:=.Path & "\" & Replace(.Name, ".csv", "_Processed.csv", Compare:=vbTextCompare)
                .Close False
                
            End With
                          
        Next
    
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
    
    End If
    
End Sub

 

[CVBALeo]

Because you're Selecting cells (what the Macro Recorder does) which is slower than addressing them directly. In the macro below I've removed all the Selects and Selections so it should be a bit faster.

Ah I did use the recorder as a starting process to create that code but didn't try to tidy it up.

It definitely doesn't open them. You need a Workbooks.Open or Workbooks.OpenText statement to open a workbook file.

Yeah... that makes sense . Thanks.

'ONE - This section removes rows 1-45, converts column A to GHz then removes column D data for cleanliness
Rows("1:45").Delete Shift:=xlUp
lastRow = Cells(Rows.Count, "D").End(xlUp).Row
Range("D1").FormulaR1C1 = "=RC[-3]/1e9"
Range("D1").AutoFill Destination:=Range("D1:D" & lastRow), Type:=xlFillDefault
Range("A1:A" & lastRow).Value = Range("D1:D" & lastRow).Value
Columns("D").Delete

[/CODE]

Issue with the blue highlighted text though. When running the code, it's throwing up a 1004 error: Autofill method of Range Class failed.
Not 100% why, tried a few things but just get various errors.


Thanks again,
Chris

 

[John_w]

When running the code, it's throwing up a 1004 error: Autofill method of Range Class failed.

Does that error occur with all files or only certain files?

That error could occur if, after rows 1:45 are deleted there are no rows or only 1 row remaining. To handle this case change the line to:

                If lastRow >= 2 Then Range("D1").AutoFill Destination:=Range("D1:D" & lastRow), Type:=xlFillDefault

 

[CVBALeo]

Does that error occur with all files or only certain files?

That error could occur if, after rows 1:45 are deleted there are no rows or only 1 row remaining. To handle this case change the line to:

                If lastRow >= 2 Then Range("D1").AutoFill Destination:=Range("D1:D" & lastRow), Type:=xlFillDefault

The error seemed to occur straight off the bat so it didn't run the code on any files unfortunately.
There is a lot of data remaining in columns A & B after removing rows 1:45 but your updated code does indeed stop the error occuring.

One thing I have noticed, and have tried to play around with to fix but can't seem to yet, is that the line: "Range("D1").FormulaR1C1 = "=RC[-3]/1e9" is only being applied to cell D1 on the new saved file that the macro creates. This seems to be something to do with that line not being applied to the whole range, but when I try to get get it to apply to the whole range ( "D1:D" & lastRow ) it also doesn't seem to work.

Sorry for the delay in responding and any further help would be appreciated!


Thanks,
Chris