run a macro in multiple files

Question

I now someone already made this question, but the thing is that I didnt understand the answers (I know nothing about programing, and very little about excel itself, so I need a step by step andwer for supids).

 

I made a macro for ONE excel file (using excel 2007):

Sub Macro6()

'

' Macro6 Macro

' basico

'

' Acceso directo: CTRL+p

'

    Range("A1:A843").Select

    Selection.Copy

    ActiveWindow.ScrollColumn = 2

    ActiveWindow.ScrollColumn = 3

    Range("J1").Select

    ActiveSheet.Paste

    Columns("J:J").ColumnWidth = 74

    Range("J1").Select

    Application.CutCopyMode = False

    Range("J1").Select

    ActiveCell.FormulaR1C1 = ""

    Columns("A:G").Select

    Range("G1").Activate

    Selection.Delete Shift:=xlToLeft

    Range("C14").Select

End Sub

The thing is, I need to run this in multiple files at the same time, and save and close each file, in all the files belonging to a folder called "DATOS TESIS BRUTO"  (D:\DATOS TESIS BRUTO) (and of course its like 1050 files so i cant run the macro one by one because itll take me ages)

Please tell me EXACTLY what I have to do.

Thank you!!

 

Answer 1

What I read from your macro is that you want to select A1:A843 and copy it to J1.
Then set the column width of column J
Then you want to clear J1 and delete columns A to G.
Removing the unnecessary code from your macro would give:

Sub Macro6Tidy()
    Range("A1:A843").Copy Range("J1")
    Columns("J:J").ColumnWidth = 74
    Range("J1").FormulaR1C1 = ""
    Columns("A:G").Delete Shift:=xlToLeft
End Sub

Now for the other files do you always want to copy 843 rows, or is the number of rows variable, but you want to copy all used rows in column A.  And do you want to set the column width to exactly 74 or to autofit its contents?  If the latter in both cases, the code would become:

Sub Macro6TidyAndGeneral()
    Range("A1",Cells(Rows.Count,"A").End(xlUp)).Copy Range("J1")
    Columns("J:J").AutoFit
    Range("J1").FormulaR1C1 = ""
    Columns("A:G").Delete Shift:=xlToLeft
End Sub

Now we need to cycle through all the files.
I suggest that it would be wise to save the changed files to a separate folder rather than overwriting the originals in case we get something wrong.

Sub DoMacro6ForAllFiles()
  Dim stPath As String
  Dim stFile As String
  Dim stNewPath as String
  stPath = "D:\Datos Tesis Bruto"
  stNewPath = "D:\New Datos"
  If Dir(stNewPath, vbDirectory)="" Then MkDir stNewPath  ' make directory if it doesn't exist
  stFile = Dir(stPath & "\*.xl*)   ' get first Excel file
  Do Until stFile = ""
    Workbooks.Open stPath & "\" & stFile, readOnly:=True   ' open the workbook
    Macro6TidyAndGeneral  ' do the changes - make sure this is the version you want to run - could be Macro6Tidy instead?
    ActiveWorkbook.SaveAs stNewPath & "\" & stFile  ' save it to the new folder
    ActiveWorkbook.Close False   ' and close it
    stFile = Dir()  ' get the next file
  Loop  ' go back and do the next file.
End Sub

 

---

Bill Manville. Excel MVP, Oxford, England. www.manville.org.uk

Answer 2

Bill,  Thank you for your qwick answer, and you are right in the variable rows and width.

Is it okey If I open one of the files in excel 2007, go to Visual Basic, and there paste this as a normal macro?

Sub DoMacro6ForAllFiles()
  Dim stPath As String
  Dim stFile As String
  Dim stNewPath as String
  stPath = "D:\Datos Tesis Bruto"
  stNewPath = "D:\New Datos"
  If Dir(stNewPath, vbDirectory)="" Then MkDir stNewPath  ' make directory if it doesn't exist
  stFile = Dir(stPath & "\*.xl*)   ' get first Excel file
  Do Until stFile = ""
    Workbooks.Open stPath & "\" & stFile, readOnly:=True   ' open the workbook
    Macro6TidyAndGeneral  ' do the changes - make sure this is the version you want to run - could be Macro6Tidy instead?
    ActiveWorkbook.SaveAs stNewPath & "\" & stFile  ' save it to the new folder
    ActiveWorkbook.Close False   ' and close it
    stFile = Dir()  ' get the next file
  Loop  ' go back and do the next file.
End Sub

 

I did this, then I tried to run this macro, but an error came up in the line that is in bold letter.  So I replaced it by:

stFile = Dir(stPath & "ABN.XLS")   ' get first Excel file

 Do Until stFile = "VELOXDEUDS.XLS"

ABN.XLS and VELOXDEUDS.XLS are my first and last files respectively inside the folder DATOS TESIS BRUTO. 

But when I do this and continue, another error comes up in:

Macro6TidyAndGeneral. When I put only Macro6Tidy the error continues because it sais that there is no Sub or Function (don´t know what that means)

 

Sorry for my scarse understanding of excel!! 

 

---

laura yanguas

Answer 3

Sorry. Typo in my original, missing closing " .

  stFile = Dir(stPath & "\*.xl*")   ' get first Excel file

Your modification would not be correct.  Giving a specific filename would only find that file.
The way Dir works is that it remembers the last call you did - in our case for *.xl* in stPath - and subsequent calls without an argument (ie Dir() ) return the other files that match the file specificatio *.xl* in the folder stPath.

You also need to copy

Sub Macro6TidyAndGeneral()
....
End Sub

from the previous reply into your module.
The line that says
  Macro6TidyAndGeneral
is a call to that procedure.

---

Bill Manville. Excel MVP, Oxford, England. www.manville.org.uk

Answer 4

Thank youu!!!  That solved problem number one!

The thing is, that when it reaches:

Macro6TidyGeneral

 

there is an error (that a "sub" or "function" is missing)

But as you use Sub and End Sub at the beggining and end of the macro, I dont know if I have to put Sub before Macro6TidyGeneral

 

 

 

 

---

laura yanguas

Answer 5

As I added to my last reply, the line which says
  Macro6TidyAndGeneral
within the DoMacro6ForAllFiles macro is a call to the Macro6TidyAndGeneral procedure.

That procedure, starting with Sub and ending with End Sub needs to be copied into your module, before or after the DoMacro6ForAllFiles procedure.  So it should look like

Sub Macro6TidyAndGeneral()
...
End Sub
Sub DoMacro6ForAllFiles()
...
  Macro6TidyAndGeneral
...
End Sub

---

Bill Manville. Excel MVP, Oxford, England. www.manville.org.uk

Answer 6

Its like it doesn´t understand what Macro6Tidy means (and me neither haha)

so I can´t finish the process! :(

 

 

 

 

---

laura yanguas

Answer 7

OOH!!! I just now read your answer! Okay! That should work!! Thank you!!!

 

 

 

---

laura yanguas

Answer 8

I just tried it! It did work!! :)

The only problem, is that cheking the files in order to see if everything was okay, I realized, that I was wrong in thinking that all files had the same number of columns (most had originaly G, but some had one less) so... I would like to do it again, but with a command that doesn´t copy column A to column J, but to the first column that is "empty". (I am trying to reorder a table as you may see).  I promise this is the LAST time I bother you! Do you know if such command exists?

This is what I had:

Sub Macro6TidyAndGeneral()
    Range("A1",Cells(Rows.Count,"A").End(xlUp)).Copy Range("J1")
    Columns("J:J").AutoFit
    Range("J1").FormulaR1C1 = ""
    Columns("A:G").Delete Shift:=xlToLeft
End Sub

And thank you in advance!

 

---

laura yanguas

Answer 9

Hmm.
Could be you want something like this:

Sub Macro6TidyAndGeneral()
    Dim rDest As Range
    Set rDest = Range("A1").Offset(,Range("A1").CurrentRegion.Columns.Count)
    Range("A1",Cells(Rows.Count,"A").End(xlUp)).Copy rDest
    rDest.EntireColumn.AutoFit
    rDest.FormulaR1C1 = ""
    Columns(1).Resize(,rDest.Column-2).Delete Shift:=xlToLeft
End Sub

I have assumed that if it goes in column I instead of J then you want to delete columns A to F rather than A to G.
If that was wrong, replace the last line with the previous  Columns("A:G").Delete Shift:=xlToLeft

---

Bill Manville. Excel MVP, Oxford, England. www.manville.org.uk

Answer 10

Hello,

I found this interesting macro and with my very limited knowledge I tried to modify/combine it to an existing macro which graphs data points from a .csv file.

What I was trying to achieve is to graph all .csv files contained in a folder into individual files.

Unfortunately and not surprisingly I can't get it to work.  It might be something silly I just don't know nearly enough to figure it out.  What happens is that the macro only graphs the currently open file only and nothing else...  Any help would be greatly appreciated.  I forgot to mention that the Sub Fill_Test_Zero_and_Graph() works fine on its own.

Here is what I have:

                         

Sub DoGraphMacroForAllFiles()
  Dim stPath As String
  Dim stFile As String
  Dim stNewPath As String
  stPath = "C:\TTT"
  stNewPath = "C:\Graphs TTT"
  If Dir(stNewPath, vbDirectory) = "" Then MkDir stNewPath ' makes directory if it doesn't exist
  stFile = Dir(stPath & "\*.csv")   ' gets first file
  Do Until stFile = ""
    Workbooks.Open stPath & "\" & stFile, ReadOnly:=True   ' opens the workbook
    Fill_Test_Zero_and_Graph  ' runs "Fill_Test_Zero_and_Graph()" module
    ActiveWorkbook.SaveAs stNewPath & "\" & stFile  ' saves it to the new folder
    ActiveWorkbook.Close False   ' and closes it
    stFile = Dir()  ' gets the next file
  Loop  ' goes back and do the next file.
End Sub
--------------------------------------------------------------------------

Sub Fill_Test_Zero_and_Graph()

' Fill_Test_Graph Macro

Set SheetName = ActiveSheet

   Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Range("B16").Select
    ActiveCell.FormulaR1C1 = "=RC[1]-R16C3"
    Range("B16").Select
    Selection.AutoFill Destination:=Range("B16:B1350"), Type:=xlFillDefault
    Range("B16:B236").Select
    Range("B15").Select
    Range("A16:B16").Select
    Range(Selection, Selection.End(xlDown)).Select
    Charts.Add
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers

    ActiveChart.SetSourceData Source:=Sheets(SheetName.Name). _
    Range("A16:B30000"), PlotBy:=xlColumns

    ActiveChart.Location Where:=xlLocationAsNewSheet
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = _
        "Nozzle Test"
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time (sec)"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Pressure (kPa)"
    End With
    ActiveChart.HasLegend = False
    ActiveChart.ChartTitle.Select
    Selection.AutoScaleFont = True
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    ActiveChart.Axes(xlCategory).AxisTitle.Select
    Selection.AutoScaleFont = True
    With Selection.Font
        .Name = "Arial"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    ActiveChart.Axes(xlValue).AxisTitle.Select
    Selection.AutoScaleFont = True
    With Selection.Font
        .Name = "Arial"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .Background = xlAutomatic
    End With
    ActiveChart.Axes(xlValue).Select
    With ActiveChart.Axes(xlValue)
        .MinimumScale = 0
        .MaximumScale = 10.5
        .MinorUnitIsAuto = True
        .MajorUnitIsAuto = True
        .Crosses = xlAutomatic
        .ReversePlotOrder = False
        .ScaleType = xlLinear
        .DisplayUnit = xlNone
    End With

    ActiveChart.ChartArea.Select
    With Selection.Border
        .ColorIndex = 57
        .Weight = xlThick
        .LineStyle = xlContinuous
    End With
    Selection.Shadow = False
    Selection.Interior.ColorIndex = xlNone

    ActiveChart.ChartTitle.Select

End Sub