Execute Excel Macro in All Excel Files in a Folder

**salventuro** · 04-22-2009, 11:04 PM

Hi Everyone,

Hope everyone is doing well.

I found the following code to execute a macro in all excel files in a folder. Sounds amazing!

I have a code to add to it, (thanks again JB!), however I am having issues getting it to work.

If someone could please take a look at it and let me know what (more like, how many things) I have done wrong, it would be greatly appreciated.

I am adding this to the Sheet 1 Worksheet.

As usual, thanks in advance.

Sub Exec_Macro_For_All()

Dim sPath As String
Dim sFile As String
Dim sDir As String
Dim oWB As Workbook
Dim i1 As Long
Dim iMax As Long

On Error GoTo Err_Clk

sPath = C: Documents MyDocuments \ looptest
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"

sDir = Dir$(sPath & "*.xls", vbNormal)
Do Until LenB(sDir) = 0
Set oWB = Workbooks.Open(sPath & sDir)
JB's code
Option Explicit
Sub DeleteDoc68()
'Locate "PEFP" and delete all rows with ID from that match
Dim rFound As Range, rID As String, i As Integer, lastrow As Long
lastrow = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = True
On Error Resume Next

Do
    With Sheet1
        Set rFound = .Columns(1).Find(what:="PEFP", After:=.Cells(1, 1), _
            LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows)
    On Error GoTo 0
        If Not rFound Is Nothing Then
            rID = Cells(rFound.Row, 2).Value
                        For i = lastrow To 2 Step -1
                If Cells(i, 2).Value = rID Then Rows(i).EntireRow.Delete Shift:=xlUp
            Next i
        End If
    End With
Loop Until rFound Is Nothing

Application.ScreenUpdating = True
End Sub
oWB.Save
oWB.Close False
sDir = Dir$
Loop

Err_Clk:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub

In all honesty, this is a bit overwhelming for me.

**Mallycat** · 04-23-2009, 02:38 AM

you need inverted commas around your path as a starter

sPath = "C:\Documents\MyDocuments\looptest"

**royUK** · 04-23-2009, 02:52 AM

It appears that you have pasted code into yor code, including

JB's code <- this will error - not code needs apostrophe in frot
Option Explicit <- should be before any code
Sub DeleteDoc68()<-should not be included in code, no End Sub precedes it

**salventuro** · 04-23-2009, 05:32 PM

Thank you royUK and Mallycat.
Hope you are both having a great day.

I have followed the instructions you provided, I must be missing something.
Running the code to open and close all the workbooks runs fine, I can see all the workbooks in the specified open and then close, (which was to cool, to see for the first time), but, the code that I added (JB's code) does not execute.

Option Explicit <- should be before any code

I see Option Explicit in the VBA window, at the top of the page.
Am I to add Option Explicit again somewhere? I have tried to add it in various places, to no avail.

P.S. I love STUUUUUPER DUCK!

Here is what it looks like now.
Sorry, for probably missing the obvious.
Thanks for your time and instructions, again.

Option Explicit
Sub Exec_Macro_For_All()

Dim sPath As String
Dim sFile As String
Dim sDir As String
Dim oWB As Workbook
Dim i1 As Long
Dim iMax As Long

On Error GoTo Err_Clk

sPath = "H:\looptest"
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"

sDir = Dir$(sPath & "*.xls", vbNormal)
Do Until LenB(sDir) = 0
Set oWB = Workbooks.Open(sPath & sDir)



'Locate "PEFP" and delete all rows with ID from that match
Dim rFound As Range, rID As String, i As Integer, lastrow As Long
lastrow = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = True
On Error Resume Next

Do
    With Sheet1
        Set rFound = .Columns(1).Find(what:="PEFP", After:=.Cells(1, 1), _
            LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows)
    On Error GoTo 0
        If Not rFound Is Nothing Then
            rID = Cells(rFound.Row, 2).Value
                        For i = lastrow To 2 Step -1
                If Cells(i, 2).Value = rID Then Rows(i).EntireRow.Delete Shift:=xlUp
            Next i
        End If
    End With
Loop Until rFound Is Nothing

Application.ScreenUpdating = True

oWB.Save
oWB.Close False
sDir = Dir$
Loop

Err_Clk:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub