Run macro against every file in a specific directory

[sfscottca]

Let's say I create a macro to delete the first 15 columns of a workbook.
Is it possible to run that macro against every .xls file in c:\commissions?

Thanks!

 

[Domenic]

Try...

Option Explicit

Sub test()

    Dim MyPath As String
    Dim MyFile As String

    MyPath = "C:\Commissions\"
    
    MyFile = Dir(MyPath & "*.xls")
    
    Do While Len(MyFile) > 0
    
        [COLOR="SeaGreen"]'Your code here[/COLOR]
        
        MyFile = Dir
        
    Loop
    
End Sub

 

[sfscottca]

Looks promising, thanks!

1. Did I insert my code properly?
2. What is the best way to run this?

Option Explicit

Sub test1()

Dim MyPath As String
Dim MyFile As String

MyPath = "C:\Commissions\"

MyFile = Dir(MyPath & "*.xls")

Do While Len(MyFile) > 0

Columns("A:A").Select
Selection.Delete Shift:=xlToLeft

MyFile = Dir

Loop

End Sub

 

[Domenic]

Try...

Option Explicit

Sub test()

    Dim wkbOpen As Workbook
    Dim MyPath As String
    Dim MyFile As String

    MyPath = "C:\Commissions\"
    
    MyFile = Dir(MyPath & "*.xls")
    
    Do While Len(MyFile) > 0
    
        Set wkbOpen = Workbooks.Open(Filename:=MyPath & MyFile)
        wkbOpen.Worksheets(1).Columns("A:A").Delete
        wkbOpen.Close savechanges:=True
        MyFile = Dir
        
    Loop
    
End Sub

Note that the macro deletes Column A from the first sheet of each workbook. To refer to a sheet specifically, replace...

wkbOpen.Worksheets(1).Columns("A:A").Delete

with

wkbOpen.Worksheets("Sheet1").Columns("A:A").Delete

 

[sfscottca]

I think this is going to work very well, thanks.
Can you help me integrate the following?

Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Sheet1").Name = "cleaned up"
Sheets("SCORE - Install Base Report 2 ").Select
Columns("G:G").Select
Selection.Copy
Sheets("cleaned up").Select
Columns("A:A").Select
ActiveSheet.Paste

Thank You!

 

[Domenic]

Is this what you mean?

Option Explicit

Sub test()

    Dim wkbOpen As Workbook
    Dim wksNew As Worksheet
    Dim MyPath As String
    Dim MyFile As String

    MyPath = "C:\Commissions\"
    MyFile = Dir(MyPath & "*.xls")
    
    Do While Len(MyFile) > 0
        Set wkbOpen = Workbooks.Open(Filename:=MyPath & MyFile)
        With wkbOpen
            .Worksheets(1).Columns("A:A").Delete
            Set wksNew = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            wksNew.Name = "Cleaned Up"
            .Sheets("SCORE - Install Base Report 2").Columns("G:G").Copy _
                Destination:=wksNew.Columns("A:A")
            .Close savechanges:=True
        End With
        MyFile = Dir
    Loop
    
End Sub

 

[sfscottca]

This is working great! I just have a few remaining edits before it's perfect.

Issue A) Sometimes the existing worksheet tab is called SCORE...1 and sometimes SCORE...2. I need the macro to handle this unpredictable naming.

Issue B) Finish the formatting of new worksheet. In summary, this macro will:

1) Open the file.

2) Create a new worksheet within the opened file, and name it "cleanup".

3) Copy the specified columns from sheet "SCORE - Install Base Report 2 " within the opened file and paste them to the newly created sheet "cleanup".

4) sort and format columns in newly created sheet "cleanup"
[FONT=&quot]<o></o>[/FONT]




Option Explicit


Sub test6()

Dim wkbOpen As Workbook
Dim wksNew As Worksheet
Dim MyPath As String
Dim MyFile As String

MyPath = "C:\temp\loop\2\"
MyFile = Dir(MyPath & "*.xlsx")

Do While Len(MyFile) > 0
Set wkbOpen = Workbooks.Open(Filename:=MyPath & MyFile)
With wkbOpen
Set wksNew = .Sheets.Add(After:=.Sheets(.Sheets.Count))
wksNew.Name = "cleanup"
.Sheets("SCORE - Install Base Report 1 ").Columns("G:G").Copy _
Destination:=wksNew.Columns("A:A")
.Sheets("SCORE - Install Base Report 1 ").Columns("H:H").Copy _
Destination:=wksNew.Columns("B:B")
.Sheets("SCORE - Install Base Report 1 ").Columns("C:C").Copy _
Destination:=wksNew.Columns("C:C")

.Sheets("cleanup").Sort.SortFields.Add Key:=Range( _
"A2:A2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal

.Sheets("cleanup").Sort.SortFields.Add Key:=Range( _
"B2:B2000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal




.Close savechanges:=True
End With
MyFile = Dir
Loop

End Sub

 

[Domenic]

As per your request, I've modified the following code so that it checks to see which sheet exists -- "SCORE - Install Base Report 1 " or "SCORE - Install Base Report 2 ". I've also included the sort routine for the "cleanup" sheet. Since it looks like you probably have headers, change 'Header:=xlGuess' to 'Header:=xlYes'.

Option Explicit

Sub test6()

    Dim wkbOpen As Workbook
    Dim wksNew As Worksheet
    Dim wksScore As Worksheet
    Dim MyPath As String
    Dim MyFile As String
    
    MyPath = "C:\temp\loop\2\"
    MyFile = Dir(MyPath & "*.xlsx")
    
    Do While Len(MyFile) > 0
        Set wkbOpen = Workbooks.Open(Filename:=MyPath & MyFile)
        With wkbOpen
            Set wksNew = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            wksNew.Name = "cleanup"
            If Evaluate("ISREF('SCORE - Install Base Report 1 '!A1)") Then
                Set wksScore = .Sheets("SCORE - Install Base Report 1 ")
            Else
                Set wksScore = .Sheets("SCORE - Install Base Report 2 ")
            End If
            wksScore.Columns("G:G").Copy Destination:=wksNew.Columns("A:A")
            wksScore.Columns("H:H").Copy Destination:=wksNew.Columns("B:B")
            wksScore.Columns("C:C").Copy Destination:=wksNew.Columns("C:C")
            With wksNew.UsedRange
                .Sort key1:=.Range("A2"), order1:=xlAscending, key2:=.Range("B2"), order2:=xlAscending, _
                    Header:=xlGuess, Ordercustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                    dataoption1:=xlSortNormal
            End With
            .Close savechanges:=True
        End With
        MyFile = Dir
    Loop

End Sub