Repeating Macro On Multiple Files In Order

CVBALeo

New Member
Joined
Feb 26, 2020
Messages
7
Office Version
  1. 2010
Platform
  1. Windows
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):

VBA Code:
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
 
The error seemed to occur straight off the bat so it didn't run the code on any files unfortunately.
But it must have opened at least one .csv file to reach the Range("D1").AutoFill Destination:=Range("D1:D" & lastRow), Type:=xlFillDefault line which caused the original error.

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.

I'm not seeing that issue. How many columns are in the input .csv files? If there are more than 4 then column D in the output "_Processed.csv" files is column E in the input .csv files, because of the Columns("D").Delete line. If you want to keep column D as an empty column in the output "_Processed.csv" files then replace that line with Columns("D").Clear.
 
Upvote 0

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
But it must have opened at least one .csv file to reach the Range("D1").AutoFill Destination:=Range("D1:D" & lastRow), Type:=xlFillDefault line which caused the original error.
You're right, I don't think I noticed it open in the background because you're right, there's no way it could get to that point in the code unless a csv was open... At least I'm learning here, haha!

I'm not seeing that issue. How many columns are in the input .csv files? If there are more than 4 then column D in the output "_Processed.csv" files is column E in the input .csv files, because of the Columns("D").Delete line. If you want to keep column D as an empty column in the output "_Processed.csv" files then replace that line with Columns("D").Clear.
There are two columns of data (A&B) in the input .csv files.
In the non-looping macro, it uses the formula
VBA Code:
=A1/1e9
in D1. Then applies that same formula to the all cells in column containing data (in this case it's a fixed number of cells as the data is always the same amount but I believe your modification does it for as many cells in column A that contain data, this is better and makes the macro a bit more futureproofed!). The new values in Column D are then copied back over to column A and column D removed, leaving the original columns A & B but with column A containing the new "x/1e9" value.

The code currently only does this for cell A1 but doesn't seem to do it for the rest... and I'm not sure why :(

I have added the
Code:
Columns("D").Clear
line also.


Thanks again,

Chris
 
Upvote 0
There are two columns of data (A&B) in the input .csv files.
I see the problem now. I thought column D contained data, so the code looks in column D to find the last row with data, but with column D empty lastRow is always 1. It should look in column A. You're using column D temporarily to hold the formulas =A1/1e9, =A2/1e9 etc. and then overwriting column A with the values. The AutoFill isn't needed because the formula can be applied to all cells in column D in one line.

Change the Section ONE code to:
VBA Code:
                Rows("1:45").Delete Shift:=xlUp
                lastRow = Cells(Rows.Count, "A").End(xlUp).Row
                Range("D1:D" & lastRow).FormulaR1C1 = "=RC[-3]/1e9"
                Range("A1:A" & lastRow).Value = Range("D1:D" & lastRow).Value
                Columns("D").Clear
 
Upvote 0

Forum statistics

Threads
1,214,833
Messages
6,121,868
Members
449,053
Latest member
Mesh

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top