Written by Allen Wyatt (last updated May 20, 2023)
This tip applies to Excel 2007, 2010, 2013, 2016, 2019, 2021, and Excel in Microsoft 365
Richard's company, like many others, uses Excel quite a bit. In fact, they have thousands and thousands of Excel workbooks that they have collected over the years. Richard needs a way to find out which of those workbooks have VBA macros in them, without the need to open and inspect each workbook individually. He wonders if there is an easy way to do this.
One rather simplistic way to find all your workbooks containing macros is to just look for any files that use the XLSM or XLSB extensions. Workbooks that contain macros must be stored in files using these extensions. While not 100% foolproof, it is a good place to start.
You could also use the search capabilities of Windows (outside of Excel) and search for any file that contains the text "End Sub" or "End Function". That will quickly identify any potential candidate workbooks, as any VBA procedure must use one of these two statements at its end. (It won't work with XLSB files, however, as the macro code in those is stored in a binary format.)
If you are using legacy workbooks (those developed using Excel 2003's file format), then you actually need to look inside each of the workbooks. This can be done programmatically, meaning that you could have a macro that opens each workbook in a folder and examines it to see if there are any macros within it.
As an example, you could create a macro that steps through each of the files in a directory and determines if the file is an Excel workbook. It can then open the file and check to see if it has a VBA project within it.
Sub FindMacros() Dim sPath As String Dim sFile As String Dim sFoundFiles As String 'specify directory to use - must end in "\" sPath = "C:\MyData\Excel Data\" sFile = Dir(sPath) Do While sFile <> "" If InStr(sFile, ".xls") > 0 Then Workbooks.Open (sPath & sFile) If Workbooks(sFile).HasVBProject Then sFoundFiles = sFoundFiles & sFile & vbCrLf End If Workbooks(sFile).Close (False) End If sFile = Dir ' Get next filename Loop If Len(sFoundFiles) = 0 Then MsgBox "No workbooks found that contain macros" Else sFoundFiles = "The following workbooks contain macros:" & _ vbCrLf & vbCrLf & sFoundFiles MsgBox sFoundFiles End If End Sub
This example uses the HasVBProject property (introduced to the Excel object model in Excel 2007) to determine whether the file has any macros or not. When complete, the macro displays a message box that lists those worksheets containing macros.
Note:
ExcelTips is your source for cost-effective Microsoft Excel training. This tip (12466) applies to Microsoft Excel 2007, 2010, 2013, 2016, 2019, 2021, and Excel in Microsoft 365. You can find a version of this tip for the older menu interface of Excel here: Finding Workbooks Containing Macros.
Dive Deep into Macros! Make Excel do things you thought were impossible, discover techniques you won't find anywhere else, and create powerful automated reports. Bill Jelen and Tracy Syrstad help you instantly visualize information to make it actionable. You’ll find step-by-step instructions, real-world case studies, and 50 workbooks packed with examples and solutions. Check out Microsoft Excel 2019 VBA and Macros today!
Perhaps the most common way of communicating with programs is through the use of dialog boxes. We expect dialog boxes to ...
Discover MoreExcel allows you to define names that can refer either to ranges of cells or to constant information, such as formulas. ...
Discover MoreOpen up a workbook, and Excel normally runs the macros associated with that workbook. You can disable the automatic ...
Discover MoreFREE SERVICE: Get tips like this every week in ExcelTips, a free productivity newsletter. Enter your address and click "Subscribe."
2023-05-30 04:22:35
sandeep kothari
THANKS J. Woolley.
2023-05-29 10:36:58
J. Woolley
@sandeep kothari
Thank you for your comment. Please replace the following statements
                Workbooks.Open (sPath & sFile), _
                    UpdateLinks:=False, ReadOnly:=True
                bIsVB = ActiveWorkbook.HasVBProject
                ActiveWorkbook.Close SaveChanges:=False
with these statements
                On Error Resume Next
                    bIsVB = Workbooks(sFile).HasVBProject
                    If Err <> 0 Then
                        Err.Clear
                        Workbooks.Open (sPath & sFile), _
                            UpdateLinks:=False, ReadOnly:=True
                        If Err = 0 Then
                            bIsVB = ActiveWorkbook.HasVBProject
                            ActiveWorkbook.Close SaveChanges:=False
                        End If
                    End If
                On Error GoTo 0
This avoids an error if sFile is already open or if it fails to open.
2023-05-28 21:21:30
sandeep kothari
Hi Woolley
Tried your macro on an open excel file (.xlsx) but didn't work. got error message, asking me to debug following codeline:
"Workbooks.Open (sPath & sFile), UpdateLinks:=False, ReadOnly:=True".
Pl chk what seems to have gone wrong.
2023-05-27 11:36:46
J. Woolley
Re. my previous comment, the Tip's macro overlooks file types .XLS, .XLSM, and .XLSB unless
    If InStr(sFile, ".xls") > 0 Then
is changed to
    If InStr(sFile, ".xls", vbTextCompare) > 0 Then
or the module includes Option Compare Text; the default is Binary, which is case sensitive.
2023-05-23 17:19:13
J. Woolley
This Tip's macro has several issues:
+ Tries to open files like Book1.xls.whatever
+ Possibly tries to open and close itself or Personal.xlsb
+ Overlooks these Excel file types: .xlt, .xltm, .xla, .xlam, .XLS, .XLS*
+ Permits annoying screen updates
+ Ignores possible workbook recalc, auto macro, or external link problems
+ Ignores MsgBox limits (about 25 lines or 1,024 characters)
Here is an improved version (which assumes Personal.xlsb, *.xla, and *.xlam always include VBA):
Sub FindMacros2()
    Const MyName As String = "FindMacros2"
    Const Header As String = " files with VBA in active workbook's folder:"
    Const MaxNbr As Integer = 25, MaxLen As Integer = 800
    Dim oldCM As Variant, oldAS As Variant, bIsVB As Boolean, bNext As Boolean
    Dim sThis As String, sPath As String, sFile As String
    Dim sLow As String, sExt As String, sMsg As String
    Dim sList As String, sPart As String, nList As Integer, nPart As Integer
    sThis = ThisWorkbook.Name
    With Application
        .ScreenUpdating = False
        oldCM = .Calculation
        .Calculation = xlCalculationManual
        oldAS = .AutomationSecurity
        .AutomationSecurity = msoAutomationSecurityForceDisable
        .EnableEvents = False
        sPath = ActiveWorkbook.Path & .PathSeparator
    End With
    ChDir sPath
    sFile = Dir("*.xl*")
    Do While sFile <> ""
        sLow = LCase(sFile)
        sExt = Mid(sLow, InStrRev(sLow, ".xl"))
        If Len(sExt) < 6 Then
            bIsVB = (sFile = sThis) Or (sLow = "personal.xlsb") _
                Or (sExt = ".xla") Or (sExt = ".xlam")
            If Not bIsVB Then
                Workbooks.Open (sPath & sFile), _
                    UpdateLinks:=False, ReadOnly:=True
                bIsVB = ActiveWorkbook.HasVBProject
                ActiveWorkbook.Close SaveChanges:=False
            End If
            If bIsVB Then
                nList = nList + 1
                sList = sList & vbLf & sFile 'complete list
                nPart = nPart + 1
                sPart = sPart & vbLf & sFile 'partial list
            End If
            If nPart = MaxNbr Or Len(sPart) > MaxLen Then
                sMsg = IIf(bNext, "Next ", "First ") & nPart & Header & sPart
                If MsgBox(sMsg, vbOKCancel, MyName) = vbCancel Then Exit Sub
                bNext = True
                nPart = 0
                sPart = ""
            End If
        End If
        sFile = Dir
    Loop
    With Application
        .EnableEvents = True
        .AutomationSecurity = oldAS
        .Calculation = oldCM
        .ScreenUpdating = True
    End With
    If nPart = 0 And (Not bNext) Then
        MsgBox "No files with VBA in active workbook's folder", , MyName
    ElseIf nPart > 0 Then
        MsgBox (IIf(bNext, "Last ", "") & nPart & Header & sPart), , MyName
    End If
    'consider copying complete sList to worksheet, document, or clipboard
End Sub
Got a version of Excel that uses the ribbon interface (Excel 2007 or later)? This site is for you! If you use an earlier version of Excel, visit our ExcelTips site focusing on the menu interface.
FREE SERVICE: Get tips like this every week in ExcelTips, a free productivity newsletter. Enter your address and click "Subscribe."
Copyright © 2025 Sharon Parq Associates, Inc.
Comments