Link to home
Start Free TrialLog in
Avatar of uceskr

asked on

Looping Excel Formats through entire file

I am trying to loop an excel format macro through a directory that contains 90 excel files.  Each file has a workbook "CurrentJE" that needs to be formatted.  The Current JE workbook is exactly the same in all 90 excel files.

I have created a VBA program to do this loop but each time I run the program, it only works in the excel file where I set it up.  

How do I make the loop program work for the entire directory (all 90 files)?

Here is the program:
Sub RunCodeOnAllXLSFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next
    Set wbCodeBook = ThisWorkbook
        With Application.FileSearch
            'Change path to suit
            .LookIn = "C:\Documents and Settings\eskridgc\My Documents\Chuck2013\SendDepts"
            .FileType = msoFileTypeExcelWorkbooks
            'Optional filter with wildcard
            .Filename = "CurrentJ*.xls"
                If .Execute > 0 Then 'Workbooks in folder
                    For lCount = 1 To .FoundFiles.Count 'Loop through all
                        'Open Workbook "CurrentJE" and Set a Workbook variable to it
                        Set wbResults = Workbooks.Open(Filename:=.CurrentJ * (lCount), UpdateLinks:=0)
    'For Formatting Workbook "CurrentJE" in each File
    Selection.ColumnWidth = 16
    Selection.NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.14996795556505
        .PatternTintAndShade = 0
    End With
    ActiveWorkbook.Worksheets("CurrentJE").Sort.SortFields.Add Key:=Range( _
        "B2:B53"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    With ActiveWorkbook.Worksheets("CurrentJE").Sort
        .SetRange Range("A1:N53")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
    End With
    ActiveWindow.SmallScroll Down:=0
    Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(4), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    Columns("B:B").ColumnWidth = 6.43

                        wbResults.Close SaveChanges:=False
                    Next lCount
                End If
        End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Open in new window

Avatar of Ken Butters
Ken Butters
Flag of United States of America image

I believe the problem is because you are referencing "ActiveWorkbook".

The ActiveWorkBook would be the one that the VBA code resides in.

It looks like you are storing your the other workbooks in wbresults?

so where you have ActiveWorkbook... try substituting "wbresults" instead.

You shouldn't have to actually activate / select cells in the other workbook(s)... if you do, it will slow down your code considerably.  You just need to make sure you reference it explicitly.
I just tried to put your code in a workbook of mine to see how far it would go...

What version of Excel are you running?   The reason I ask is that "Application.FileSearch" was deprecated in Excel 2007... and it will not work in Excel 2010 either.

However... that was not obvious right away because the "On Error Resume Next" masked this problem.

If you are using Excel 2007 or later you will need to change your logic to either a "Dir" function, or possibly File System Object.
Avatar of uceskr


Does the workbooks I want to format have to be open or can the Loop application just format all the workbooks in a directory with out them being open?
Avatar of uceskr


I'm using Excel2007
Avatar of Ken Butters
Ken Butters
Flag of United States of America image

Link to home
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial