Change Column & Row labels in ALL WorkBooks within a specified folder.

S.H.A.D.O.

Well-known Member
Joined
Sep 6, 2005
Messages
1,915
Hi everyone,

I am using Excel2007.

I want to loop through ALL the WorkBooks in a specified folder and change the column and row labels from their default which is Tahoma to Verdana and then Save the WorkBook.

I have put this code together from snippets I have found searching Google and doing a Macro record, but unfortunately I just can't seem to get it to work.

Code:
Option Explicit

Sub Change_ColumnAndRow_Labels()
    Dim wbCount As Long
    Dim wbToChange As Workbook
    Dim wbToUpdate As Workbook
    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual
        .DisplayAlerts = False: .EnableEvents = False
    End With
    On Error Resume Next
    Set wbToUpdate = ThisWorkbook
    With Application.FileSearch
        .NewSearch
        .LookIn = "C:\Users\My Name\Documents\My Name\Test Folder" ' Path of my folder to change.
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute > 0 Then ' Loop through folder until all WorkBooks are done.
            For wbCount = 1 To .FoundFiles.Count
                Set wbToChange = Workbooks.Open(Filename:=.FoundFiles(wbCount), UpdateLinks:=0)
                With ActiveWorkbook.Styles("Normal")
                    .IncludeNumber = True
                    .IncludeFont = True ' <<< Don't think I need this.
                    .IncludeAlignment = True ' <<< Don't think I need this.
                    .IncludeBorder = True ' <<< Don't think I need this.
                    .IncludePatterns = True ' <<< Don't think I need this.
                    .IncludeProtection = True ' <<< Don't think I need this.
                End With
                With ActiveWorkbook.Styles("Normal").Font
                    .Name = "Verdana"
                    .Size = 10 ' <<< Don't think I need this.
                    .Bold = False ' <<< Don't think I need this.
                    .Italic = False ' <<< Don't think I need this.
                    .Underline = xlUnderlineStyleNone ' <<< Don't think I need this.
                    .Strikethrough = False ' <<< Don't think I need this.
                    .ThemeColor = 2 ' <<< Don't think I need this.
                    .TintAndShade = 0 ' <<< Don't think I need this.
                    .ThemeFont = xlThemeFontNone ' <<< Don't think I need this.
                End With
                wbToChange.Close SaveChanges:=False ' <<< Is this CORRECT!
            Next wbCount
        End If
    End With
    On Error GoTo 0
    With Application
        .EnableEvents = True: .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
    End With
End Sub

Any help will be greatly appreciated.
Thanks in advance.
 
Last edited:

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
File search was removed in 2007 you should look to use DIR commands. You could use something like this. If you are changing the style are all the cells just default style, or have you formatted them?

Sub Open_My_Files()
Dim mypath As String
Dim MyFile As String
mypath = "M:\Access Files\"
MyFile = Dir(mypath)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Do While MyFile <> ""
If MyFile Like "*.xls" Then
Workbooks.Open mypath & MyFile
Range("A1:A65536,B1:IV1").Font.Name = "Verdana"
Range("A1:A65536,B1:IV").Font.Size = 10

ActiveWorkbook.Close True
End If
MyFile = Dir
Loop
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub
 
Upvote 0
Thanks for the reply Trvor,

File search was removed in 2007 you should look to use DIR commands. You could use something like this. If you are changing the style are all the cells just default style, or have you formatted them?

I actually have my WorkBooks set to default Verdana now so there is not a problem.
My OLD WorkBooks that I use, some of them have evolved over many years, I ran a program individually for each WorkBook over a period of time to change ALL the cells within them to Verdana, which is great, but the Column & Row labels are still set to Tahoma which is what I wish to change in these WorkBooks. It is only the Column & Row labels that I want to change in these WorkBooks.

I will look into using the DIR commands as you have suggested.

Thanks in advance.
 
Upvote 0
I have amended the code as below but am still having problems.
Any help will be greatly appreciated.

Code:
Sub Change_ColumnAndRow_Labels()
    Dim wbBook As Workbook
    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual
        .DisplayAlerts = False: .EnableEvents = False
    End With
    With CreateObject("Scripting.FileSystemObject")
        For Each File In .GetFolder("C:\Users\My Name\Documents\My Name\Test Folder").Files
            If .GetExtensionName(File) = "xlsx" Then
                Set wbBook = Workbooks.Open(Filename:=File.Path, UpdateLinks:=0)
                For Each wbBook In wbBook.Worksheets
                    
                With ActiveWorkbook.Styles("Normal")
                    .IncludeNumber = True
                    .IncludeFont = True ' <<< Don't think I need this.
                    .IncludeAlignment = True ' <<< Don't think I need this.
                    .IncludeBorder = True ' <<< Don't think I need this.
                    .IncludePatterns = True ' <<< Don't think I need this.
                    .IncludeProtection = True ' <<< Don't think I need this.
                End With
                With ActiveWorkbook.Styles("Normal").Font
                    .Name = "Verdana"
                    .Size = 10 ' <<< Don't think I need this.
                    .Bold = False ' <<< Don't think I need this.
                    .Italic = False ' <<< Don't think I need this.
                    .Underline = xlUnderlineStyleNone ' <<< Don't think I need this.
                    .Strikethrough = False ' <<< Don't think I need this.
                    .ThemeColor = 2 ' <<< Don't think I need this.
                    .TintAndShade = 0 ' <<< Don't think I need this.
                    .ThemeFont = xlThemeFontNone ' <<< Don't think I need this.
                End With
                    
                Next wbBook
                wbBook.Close SaveChanges:=True
                Set wbBook = Nothing
            End If
        Next File
    End With
    With Application
        .EnableEvents = True: .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
    End With
End Sub

Thanks in advance.
 
Upvote 0
Hi everyone,

If someone could tell me what I am doing wrong or point me in the right direction I would appreciate it.

Thanks in advance.
 
Upvote 0
That isn't a DIR loop as shown in Trevor G's code, but will do the same thing.

Get rid of the For Each wbBook loop and change both the With ActiveWorkbook lines to With wbBook.
 
Upvote 0
Thanks for the reply John_w,

I adapted the code as below but unfortunately it still doesn't work.

Code:
Sub Change_ColumnAndRow_Labels()
    Dim wbBook As Workbook
    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual
        .DisplayAlerts = False: .EnableEvents = False
    End With
    With CreateObject("Scripting.FileSystemObject")
        For Each File In .GetFolder("C:\Users\My Name\Documents\My Name\Test Folder").Files
            If .GetExtensionName(File) = "xlsx" Then
                Set wbBook = Workbooks.Open(Filename:=File.Path, UpdateLinks:=0)
                With wbBook.Styles("Normal")
                    .IncludeNumber = True
                    .IncludeFont = True ' <<< Don't think I need this.
                    .IncludeAlignment = True ' <<< Don't think I need this.
                    .IncludeBorder = True ' <<< Don't think I need this.
                    .IncludePatterns = True ' <<< Don't think I need this.
                    .IncludeProtection = True ' <<< Don't think I need this.
                End With
                With wbBook.Styles("Normal").Font
                    .Name = "Verdana"
                    .Size = 10 ' <<< Don't think I need this.
                    .Bold = False ' <<< Don't think I need this.
                    .Italic = False ' <<< Don't think I need this.
                    .Underline = xlUnderlineStyleNone ' <<< Don't think I need this.
                    .Strikethrough = False ' <<< Don't think I need this.
                    .ThemeColor = 2 ' <<< Don't think I need this.
                    .TintAndShade = 0 ' <<< Don't think I need this.
                    .ThemeFont = xlThemeFontNone ' <<< Don't think I need this.
                End With
                wbBook.Close SaveChanges:=True
                Set wbBook = Nothing
            End If
        Next File
    End With
    With Application
        .EnableEvents = True: .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
    End With
End Sub

I did check the path and change the My Name part.

Thanks in advance.
 
Upvote 0
Code:
            If .GetExtensionName(File) = "xlsx" Then
Are they .xlsx files? Try debugging by pressing the F8 key in the VB editor.

This cut-down code works for me (at least in Excel 2003 for which I changed the "xlsx" in the code to "xls") - you need to change the folder path where commented.
Code:
Sub Change_ColumnAndRow_Labels()

    Dim FSO As Object, File As Object
    Dim wbBook As Workbook
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    For Each File In FSO.GetFolder("C:\path\to\folder").Files           'CHANGE THIS FOLDER PATH
        If FSO.GetExtensionName(File) = "xlsx" Then
            Set wbBook = Workbooks.Open(Filename:=File.Path, UpdateLinks:=0)
            wbBook.Styles("Normal").Font.Name = "Verdana"
            wbBook.Close SaveChanges:=True
        End If
    Next
    
End Sub
Note that the above changes the font style of text in cells as well as the column and row labels.
 
Upvote 0
Hi John_w,

Are they .xlsx files?

Note: that the above changes the font style of text in cells as well as the column and row labels.

Do you know what John, it was me being a bit slow in my old age. The extension should be .xlsm.

Code:
        If FSO.GetExtensionName(File) = "xlsm" Then
The trouble is that I don't want the font style of text in cells changed, just the column and row labels.
Anyway, I ran your code on my ten test WorkBooks and it absoloutely flew through them changing not only the text but the column and row labels as you had already mentioned.
I then changed the extension in my last code and ran that, that finally worked only changing the column and row labels, BUT, it was a lot slower than your code.
I will have a go at trying to merge the two codes into one.

Thanks again John.
 
Upvote 0
CORRECTION!

When I ran my code that ALSO changed the font style of ALL the cells within the WorkBook, I don't know what I was thinking with the last post, appologies.
If anyone knows of a way to JUST change the column and row labels whilst leaving the cells themselves intact I would appreciate it.
Thanks in advance.
 
Upvote 0

Forum statistics

Threads
1,213,483
Messages
6,113,919
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top