• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to add font and font size module

Eloise T

Active Member
I have a multi-sheet workbook. Each spreadsheet tab in the workbook represents an individual. The data consists of 10 columns on each tab and starts in Row 3. So far with the help of various friends, many from Chandoo, I have cobbled together a VBA that "adjusts" the data (see VBA code). Each week I add rows of data and then run the VBA to make the adjustments so I don't have to manually.

My next effort is to add to another module to the VBA code to change the font and font size from whatever it may be to Calibri font, font size 11.

The VBA code (the new module SIX) I believe should look similarly to the following:

Code:
'Sub Calibri&11()
For Each cll In ws.Range(ws.Cells(3, "A:H"), ws.Cells(ws.Rows.Count, "A:H").End(xlUp)).Cells
With cll
x = Evaluate("MIN(IFERROR(FIND(ROW(10:99)," & .Address(0, 0, , 1) & "),""""))")
If x > 0 Then
With .Characters(Start:=x, Length:=30).Font
.Font.Name = "Calibri"
.Font.Size = 11
End With
End If
End With
Next cll
'End Sub



The code of the currently working VBA that the above needs to fit in is as follows:

Code:
Sub ChangeCase()

' ChangeCase is five VBA modules in one. See Subs below: TRIMnCLEAN(), ChangeCase(), REDnBOLD(), DateChange(), and CurrencyFix.

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

If ws.Name <> "Formula Info" And ws.Name <> "Dale Purdy" Then

' If ws.Name <> "Formula Info" And ws.Name <> "Next Tech" Then Note: to add more just put (And ws.Name <> "name") before Then

' Change "Formula Info" sheet name or you can use sheet index# instead of name.



If ws.Cells(Rows.Count, 3).End(xlUp).Row > 2 Then

' The 3 in (Rows.Count, 3) tells this Subroutine to start in the 3rd row.

' This line was added to "fix" Error 400 which was caused by blank tab(s).

' The "Next Tech" tab has no data, and its header is in row 2.

' The part which returns the last row of data is: ws.Cells(Rows.Count, 3).End(xlUp).Row

' which will return 3 or more as long as the worksheet has data; thus subtracting 2 from

' this value returns any number from 1 upwards. However, when the worksheet has no data,

' the above code will return 2, and subtracting 2 from this = 0, which is an invalid row

' number in Excel. To check this, we test whether the value returned by the above code

' is greater than 2; if so, we proceed further, else we exit.

'ONE-------------------------------------

' Sub TRIMnCLEAN()

With ws.[A3:D3].Resize(ws.Cells(Rows.Count, 3).End(xlUp).Row - 2)

' > > > This VBA removes leading and trailing spaces in the array of Columns A through D.

' A3:D3 array tells where to apply change(s). (Rows.Count, 3) tells in which column to start.

' .Value = .Parent.Evaluate(Replace("IF(#>"""",TRIM(#),"""")", "#", .Address)) removes leading and trailing spaces.

' Added CLEAN to remove leading and trailing ASCII characters 0-31.

.Value = .Parent.Evaluate(Replace("IF(#>"""",TRIM(CLEAN(#)),"""")", "#", .Address))

End With

' End Sub

'TWO-------------------------------------

' Sub ChangeCase()

With ws.[E3:F3].Resize(ws.Cells(Rows.Count, 3).End(xlUp).Row - 2)

' > > > This VBA changes all characters in the array defined by Columns E and F to UPPER case.

' E3:F3 array tells where to apply change(s). (Rows.Count, 3) tells in which column to start.

.Value = .Parent.Evaluate(Replace("IF(#>"""",UPPER(#),"""")", "#", .Address))

End With

' End Sub

'THREE----------------------------------- Immediate ?workbooks.Count ? application.StartupPath

' Sub REDnBOLD()

For Each cll In ws.Range(ws.Cells(3, "C"), ws.Cells(ws.Rows.Count, "C").End(xlUp)).Cells

' > > > This VBA segment changes the TV Model screen size between 70 and 90 inches to red and Bold and

' starts in Row 3, Column C, and applies to each tab in the Excel workbook, except for tab "Formula Info" tab.

With cll

x = Evaluate("MIN(IFERROR(FIND(ROW(10:99)," & .Address(0, 0, , 1) & "),""""))")

If x > 0 Then

y = CLng(Mid(cll.Value, x, 2))

If y >= 70 And y <= 90 Then

With .Characters(Start:=x, Length:=2).Font

.FontStyle = "Bold"

.Color = -16776961

End With

End If

End If

End With

Next cll

' End Sub

'FOUR-----------------------------------

' Sub DateChange()

' constants

' Const ksFormat = "mm/dd/yyyy"

' > > > This VBA segment changes the dates in Column G from whatever the format happens to be to "mm/dd/yyyy"

' declarations

Dim lRow As Long, iColumn As Integer, lRowest As Long

' start 1Row starts at row 3, iColumn starts at column G(7)

lRow = 3

iColumn = 7

' process

With ws

lRowest = .Cells(.Rows.Count, iColumn).End(xlUp).Row

Do While lRow <= lRowest

' Debug.Print lRow

With .Cells(lRow, iColumn)

' If Len(.Cells(lRow, iColumn).Value) > 0 Then

If .NumberFormat <> "mm/dd/yyyy" Then .NumberFormat = "mm/dd/yyyy"

lRow = lRow + 1

End With

Loop

End With

' End Sub

'FIVE------------------------------------ Columns("E:E").NumberFormat = "$#.##0"

' Sub CurrencyFix()

' > > > This VBA segment changes the currency in Column H from whatever the format happens to be to "$#,##0"

' declarations

'' Dim lRow As Long, iColumn As Integer, lRowest As Long

'' Dim ws As Worksheet

' start 1Row starts at row 3, iColumn starts at column H(8)

lRow = 3

iColumn = 8

' process

With ws

lRowest = .Cells(.Rows.Count, iColumn).End(xlUp).Row

Do While lRow <= lRowest

' Debug.Print lRow

With .Cells(lRow, iColumn)

' If Len(.Cells(lRow, iColumn).Value) > 0 Then

If .NumberFormat <> "$#,##0" Then .NumberFormat = "$#,##0"

lRow = lRow + 1

End With

Loop

End With

' End Sub



'SIX-------------------------------------

' Sub Font&SizeFix()

' > > > This VBA segment (when done) will change the font and font size in Columns A thru J from whatever to Calibri and 11.



' .Font.Name = "Calibri"

' .Font.Size = 11









'-----------If ws.Cells(Rows.Count, 3).End(xlUp).Row > 2 Then
End If



'-------If ws.Name <> "Formula Info" And ws.Name <> "Next Tech" Then
End If



Next

'3-BEEPS-TO-SIGNAL-END--------------------------------

Beep

' Pause a second before engaging the next Beep so they don't run together and sound like only one Beep.

Application.Wait Now + TimeValue("0:00:01")

Beep

' Pause a second before engaging the next Beep so they don't run together and sound like only one Beep.

Application.Wait Now + TimeValue("0:00:01")

Beep

End Sub


Thanks for looking.
 
Like below maybe:
Code:
Sub ChangeFontToCalibri11()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
    With ws.UsedRange.Font
        .Size = 11
        .Name = "Calibri"
    End With
Next
End Sub
 
whats wrong with that code?

It should drop in ok at:

Code:
  'SIX-------------------------------------
 
  ' Sub Font&SizeFix()
 
  For Each cll In ws.Range(ws.Cells(3, "A:H"), ws.Cells(ws.Rows.Count, "A:H").End(xlUp)).Cells
  With cll
  x = Evaluate("MIN(IFERROR(FIND(ROW(10:99)," & .Address(0, 0, , 1) & "),""""))")
  If x > 0 Then
  With .Characters(Start:=x, Length:=30).Font
  .Font.Name = "Calibri"
  .Font.Size = 11
  End With
  End If
  End With
  Next cll
 
whats wrong with that code?

It should drop in ok at:

Code:
  'SIX-------------------------------------

  ' Sub Font&SizeFix()

  For Each cll In ws.Range(ws.Cells(3, "A:H"), ws.Cells(ws.Rows.Count, "A:H").End(xlUp)).Cells
  With cll
  x = Evaluate("MIN(IFERROR(FIND(ROW(10:99)," & .Address(0, 0, , 1) & "),""""))")
  If x > 0 Then
  With .Characters(Start:=x, Length:=30).Font
  .Font.Name = "Calibri"
  .Font.Size = 11
  End With
  End If
  End With
  Next cll
All I can tell you is my rendition wouldn't work.
For some reason it hung up on both
.Font.Name = "Calibri"
and .Font.Size = 11

Trying shrivallabha's code next.
 
Last edited:
Like below maybe:
Code:
Sub ChangeFontToCalibri11()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
    With ws.UsedRange.Font
        .Size = 11
        .Name = "Calibri"
    End With
Next
End Sub
Thank you shrivallabha. We're very close.

The good news is your code runs as a stand-alone module; however, I would like for it to "drop in" at the end of modules ONE - FIVE (please see VBA code at top) as a new additional (module SIX). Additionally, since my headers/titles are larger than font size 11, I would like to start in row 3 so the headers are bypassed and confined to Columns A to H on each Worksheet.

When I dropped this new module in as SIX, ws has already been used in the current VBA code so it would not compile. I (') commented "Dim ws As Worksheet" out. Once I did that, it would not compile at "For Each ws In ActiveWorkbook.Worksheets"

I know ws is a good label as it has been used multiple times in the current modules ONE - FIVE.

Thank you again for your assistance.
 
@shrivallabha
Hi, buddy!
I forgot to tell you about don't posting code at threads of this OP (@Eloise T) since she's playing as Dr. Frankenstein, building a sort of monster from a many snippets all joined by screws & nuts. I'm afraid is very late for you :(
Regards!

Hi, Eloise T!
How're you doing?
Regards!
 
@shrivallabha
Hi, buddy!
I forgot to tell you about don't posting code at threads of this OP (@Eloise T) since she's playing as Dr. Frankenstein, building a sort of monster from a many snippets all joined by screws & nuts. I'm afraid is very late for you :(
Regards!

Hi, Eloise T!
How're you doing?
Regards!
You're a mean one, Mr. Grinch. Gave you a 6-pack of Carlsberg and you didn't share with anyone. Tsk, tsk, tsk. ...and that's Miss Frankenstein to you. :DD
@shrivallabha
Hi, buddy!
I forgot to tell you about don't posting code at threads of this OP (@Eloise T) since she's playing as Dr. Frankenstein, building a sort of monster from a many snippets all joined by screws & nuts. I'm afraid is very late for you :(
Regards!

Hi, Eloise T!
How're you doing?
Regards!
 
there are too many Fonts there
Change to that shown below

Code:
With .Characters(Start:=x, Length:=30).Font
  .Name = "Calibri"
  .Size = 11
 
there are too many Fonts there
Change to that shown below

Code:
With .Characters(Start:=x, Length:=30).Font
  .Name = "Calibri"
  .Size = 11
First of all, thank you for your response.

I would like shrivallabha's cleaner code to work rather than what's at the bottom here but it needs to start at row 3 and limit itself to columns A through H.

Regarding your comment on font name and size code...I understand and yet I don't. I noticed that
.Name and .Size make a difference over
.Font.Name and .Font.Size. The former works, the latter does not.

When I run the macro it's not starting at the beginning of the cell. Note Figure 1 [before] and Figure 2 [after]. Only the right part of the data in the cell is being changed to Calibri 11. ???

FIGURE 1 [BEFORE]
upload_2017-8-4_0-6-2.png

FIGURE 2 [AFTER]
upload_2017-8-4_0-7-26.png

CURRENT CODE:
Code:
'SIX-------------------------------------
'          Sub ChangeFontToCalibri11()
'        > > > This VBA segment changes the font and font size in Columns A thru H from whatever to Calibri and 11.
                For Each cll In ws.Range(ws.Cells(3, "D"), ws.Cells(ws.Rows.Count, "D").End(xlUp)).Cells
                With cll
                    x = Evaluate("MIN(IFERROR(FIND(ROW(10:99)," & .Address(0, 0, , 1) & "),""""))")
                    If x > 0 Then
                        With .Characters(Start:=x, Length:=25).Font
                            .Name = "Calibri"
                            .Size = 11
                        End With
                    End If
                End With
                Next cll
'         End Sub
 
Last edited:
To extend to Column H use
Code:
'SIX-------------------------------------
'  Sub ChangeFontToCalibri11()
'  > > > This VBA segment changes the font and font size in Columns A thru H from whatever to Calibri and 11.
  For Each cll In ws.Range(ws.Cells(3, "D"), ws.Cells(ws.Rows.Count, "H").End(xlUp)).Cells
  With cll
  x = Evaluate("MIN(IFERROR(FIND(ROW(10:99)," & .Address(0, 0, , 1) & "),""""))")
  If x > 0 Then
  With .Characters(Start:=x, Length:=25).Font
  .Name = "Calibri"
  .Size = 11
  End With
  End If
  End With
  Next cll
'  End Sub

the issue with Font was that it was there twice in the original code

With .Characters(Start:=x, Length:=25).Font
.Font.Name = "Calibri"
.Font.Size = 11

I removed the Bold Red bits
 
Thank you shrivallabha. We're very close.

The good news is your code runs as a stand-alone module; however, I would like for it to "drop in" at the end of modules ONE - FIVE (please see VBA code at top) as a new additional (module SIX). Additionally, since my headers/titles are larger than font size 11, I would like to start in row 3 so the headers are bypassed and confined to Columns A to H on each Worksheet.

When I dropped this new module in as SIX, ws has already been used in the current VBA code so it would not compile. I (') commented "Dim ws As Worksheet" out. Once I did that, it would not compile at "For Each ws In ActiveWorkbook.Worksheets"

I know ws is a good label as it has been used multiple times in the current modules ONE - FIVE.

Thank you again for your assistance.
Here's modified code. I have changed variable name. If it still conflicts with something then you can always do find and replace to a non conflicting one.
Code:
Sub ChangeFontToCalibri11()
Dim wksFnt As Worksheet
Dim rngFnt As Range
For Each wksFnt In ActiveWorkbook.Worksheets
Set rngFnt = Intersect(wksFnt.Range("A3:H" & Rows.Count), wksFnt.UsedRange)
    If Not rngFnt Is Nothing Then
        With rngFnt.Font
            .Size = 11
            .Name = "Calibri"
        End With
    End If
Next
End Sub
 
To extend to Column H use
Code:
'SIX-------------------------------------
'  Sub ChangeFontToCalibri11()
'  > > > This VBA segment changes the font and font size in Columns A thru H from whatever to Calibri and 11.
  For Each cll In ws.Range(ws.Cells(3, "D"), ws.Cells(ws.Rows.Count, "H").End(xlUp)).Cells
  With cll
  x = Evaluate("MIN(IFERROR(FIND(ROW(10:99)," & .Address(0, 0, , 1) & "),""""))")
  If x > 0 Then
  With .Characters(Start:=x, Length:=25).Font
  .Name = "Calibri"
  .Size = 11
  End With
  End If
  End With
  Next cll
'  End Sub

the issue with Font was that it was there twice in the original code

With .Characters(Start:=x, Length:=25).Font
.Font.Name = "Calibri"
.Font.Size = 11

I removed the Bold Red bits
Thank you!!!
 
Here's modified code. I have changed variable name. If it still conflicts with something then you can always do find and replace to a non conflicting one.
Code:
Sub ChangeFontToCalibri11()
Dim wksFnt As Worksheet
Dim rngFnt As Range
For Each wksFnt In ActiveWorkbook.Worksheets
Set rngFnt = Intersect(wksFnt.Range("A3:H" & Rows.Count), wksFnt.UsedRange)
    If Not rngFnt Is Nothing Then
        With rngFnt.Font
            .Size = 11
            .Name = "Calibri"
        End With
    End If
Next
End Sub
Thank you!!! Great effort! It works as needed!
 
Last edited:
To extend to Column H use
Code:
'SIX-------------------------------------
'  Sub ChangeFontToCalibri11()
'  > > > This VBA segment changes the font and font size in Columns A thru H from whatever to Calibri and 11.
  For Each cll In ws.Range(ws.Cells(3, "D"), ws.Cells(ws.Rows.Count, "H").End(xlUp)).Cells
  With cll
  x = Evaluate("MIN(IFERROR(FIND(ROW(10:99)," & .Address(0, 0, , 1) & "),""""))")
  If x > 0 Then
  With .Characters(Start:=x, Length:=25).Font
  .Name = "Calibri"
  .Size = 11
  End With
  End If
  End With
  Next cll
'  End Sub

the issue with Font was that it was there twice in the original code

With .Characters(Start:=x, Length:=25).Font
.Font.Name = "Calibri"
.Font.Size = 11

I removed the Bold Red bits
I'm not a VBA programmer but I see what you mean.

I assume either:

With rngFnt.Font
.Size = 11
.Name = "Calibri"

OR

With rngFnt
.Font.Size = 11
.Font.Name = "Calibri"

CORRECT?
 
I'm not a VBA programmer but I see what you mean.

I assume either:

With rngFnt.Font
.Size = 11
.Name = "Calibri"

OR

With rngFnt
.Font.Size = 11
.Font.Name = "Calibri"

CORRECT?
Yes. It is one of the features of VBA.

It ultimately means the following:
Code:
rngFnt.Font.Size = 11
rngFnt.Font.Name = "Calibri"

Benefits:
- You don't have to type preceding object references repetitively i.e. rngFnt.Font part.
- Code structure also becomes more readable.
 
Yes. It is one of the features of VBA.

It ultimately means the following:
Code:
rngFnt.Font.Size = 11
rngFnt.Font.Name = "Calibri"

Benefits:
- You don't have to type preceding object references repetitively i.e. rngFnt.Font part.
- Code structure also becomes more readable.

Please see the completely working VBA code and the commented SEGMENTS A, B, & C, I inserted. I added these segments to Left or Right Justify or Center the text, et. al. I was not sure if I needed to put something in front of the segments, like what you showed me with the .font above (Permalink #20).

As it turns out, it worked with all the added segments and I didn't have to add anything in front. Can you explain why? I'm not used to having new Excel or VBA code work the first time! :DD

Code:
Sub ChangeCase()
' ChangeCase is six VBA modules in one.  See Subs below: TRIMnCLEAN(), ChangeCase(), REDnBOLD(), DateFix(), CurrencyFix()
'  and ChangeFontToCalibri.11().
  Dim ws As Worksheet
  For Each ws In ThisWorkbook.Worksheets
  If ws.Name <> "Formula Info" And ws.Name <> "Dale Purdy" Then
'  If ws.Name <> "Formula Info" And ws.Name <> "Next Tech" Then  Note: to add more just put (And ws.Name <> "name") before Then
'  Change "Formula Info" sheet name or you can use sheet index# instead of name.

  If ws.Cells(Rows.Count, 3).End(xlUp).Row > 2 Then
'  The 3 in (Rows.Count, 3) tells this Subroutine to start in the 3rd row.
'  This line was added to "fix" Error 400 which was caused by blank tab(s).
'  The "Next Tech" tab has no data, and its header is in row 2.
'  The part which returns the last row of data is:  ws.Cells(Rows.Count, 3).End(xlUp).Row
'  which will return 3 or more as long as the worksheet has data; thus subtracting 2 from
'  this value returns any number from 1 upwards.  However, when the worksheet has no data,
'  the above code will return 2, and subtracting 2 from this = 0, which is an invalid row
'  number in Excel.  To check this, we test whether the value returned by the above code
'  is greater than 2; if so, we proceed further, else we exit.
'ONE-------------------------------------
'  Sub TRIMnCLEAN()
  With ws.[A3:D3].Resize(ws.Cells(Rows.Count, 3).End(xlUp).Row - 2)
'  > > > This VBA removes leading and trailing spaces in the array of Columns A through D.
'  A3:D3 array tells where to apply change(s).  (Rows.Count, 3) tells in which column to start.
'  .Value = .Parent.Evaluate(Replace("IF(#>"""",TRIM(#),"""")", "#", .Address)) removes leading and trailing spaces.
'  Added CLEAN to remove leading and trailing ASCII characters 0-31.
  .Value = .Parent.Evaluate(Replace("IF(#>"""",TRIM(CLEAN(#)),"""")", "#", .Address))




'  INSERTED THIS SEGMENT "A" HERE
'  THIS CENTERS VERTICAL ALIGNMENT AND LEFT JUSTIFIES HORIZONTAL ALIGNMENT
   .HorizontalAlignment = xlLeft
  .VerticalAlignment = xlCenter
  .WrapText = False
  .Orientation = 0
  .AddIndent = False
  .IndentLevel = 0
  .ShrinkToFit = False
  .ReadingOrder = xlContext
  .MergeCells = False



  End With
'  End Sub
'TWO-------------------------------------
'  Sub ChangeCase()
  With ws.[E3:F3].Resize(ws.Cells(Rows.Count, 3).End(xlUp).Row - 2)
'  > > > This VBA changes all characters in the array defined by Columns E and F to UPPER case.
'  E3:F3 array tells where to apply change(s).  (Rows.Count, 3) tells in which column to start.
  .Value = .Parent.Evaluate(Replace("IF(#>"""",UPPER(#),"""")", "#", .Address))


'  INSERTED THIS SEGMENT "A" HERE
'  THIS CENTERS VERTICAL ALIGNMENT AND LEFT JUSTIFIES HORIZONTAL ALIGNMENT
   .HorizontalAlignment = xlLeft
  .VerticalAlignment = xlCenter
  .WrapText = False
  .Orientation = 0
  .AddIndent = False
  .IndentLevel = 0
  .ShrinkToFit = False
  .ReadingOrder = xlContext
  .MergeCells = False


  End With
'  End Sub
'THREE----------------------------------- Immediate  ?workbooks.Count  ? application.StartupPath
'  Sub REDnBOLD()
  For Each cll In ws.Range(ws.Cells(3, "C"), ws.Cells(ws.Rows.Count, "C").End(xlUp)).Cells
'  > > > This VBA segment changes the TV Model screen size between 70 and 90 inches to red and Bold and
'  starts in Row 3, Column C, and applies to each tab in the Excel workbook, except for tab "Formula Info" tab.
  With cll
  x = Evaluate("MIN(IFERROR(FIND(ROW(10:99)," & .Address(0, 0, , 1) & "),""""))")
  If x > 0 Then
  y = CLng(Mid(cll.Value, x, 2))
  If y >= 70 And y <= 90 Then
  With .Characters(Start:=x, Length:=2).Font
  .FontStyle = "Bold"
  .Color = -16776961
  End With
  End If
  End If
  End With
  Next cll
'  End Sub
'FOUR-----------------------------------
'  Sub DateFix()
'  constants
'  Const ksFormat = "mm/dd/yyyy"
'  > > > This VBA segment changes the dates in Column G from whatever the format happens to be to "mm/dd/yyyy"
'  declarations
  Dim lRow As Long, iColumn As Integer, lRowest As Long
'  start  1Row starts at row 3, iColumn starts at column G(7)
  lRow = 3
  iColumn = 7
'  process
  With ws
  lRowest = .Cells(.Rows.Count, iColumn).End(xlUp).Row
  Do While lRow <= lRowest
'  Debug.Print lRow
  With .Cells(lRow, iColumn)
'  If Len(.Cells(lRow, iColumn).Value) > 0 Then
  If .NumberFormat <> "mm/dd/yyyy" Then .NumberFormat = "mm/dd/yyyy"






'  INSERTED THIS SEGMENT "B" HERE
'  THIS CENTERS BOTH VERTICAL ALIGNMENT AND HORIZONTAL ALIGNMENT

  .HorizontalAlignment = xlCenter
  .VerticalAlignment = xlCenter
  .WrapText = False
  .Orientation = 0
  .AddIndent = False
  .IndentLevel = 0
  .ShrinkToFit = False
  .ReadingOrder = xlContext
  .MergeCells = False




  lRow = lRow + 1
  End With
  Loop
  End With
'  End Sub
'FIVE------------------------------------
'  Sub CurrencyFix()
'  > > > This VBA segment changes the currency in Column H from whatever the format happens to be to "$#,##0"
'  declarations
  ''  Dim lRow As Long, iColumn As Integer, lRowest As Long
  ''  Dim ws As Worksheet
'  start  1Row starts at row 3, iColumn starts at column H(8)
  lRow = 3
  iColumn = 8
'  process
  With ws
  lRowest = .Cells(.Rows.Count, iColumn).End(xlUp).Row
  Do While lRow <= lRowest
'  Debug.Print lRow
  With .Cells(lRow, iColumn)
'  If Len(.Cells(lRow, iColumn).Value) > 0 Then
  If .NumberFormat <> "$#,##0" Then .NumberFormat = "$#,##0"







'  INSERTED THIS SEGMENT "C" HERE
'  THIS CENTERS VERTICAL ALIGNMENT AND RIGHT JUSTIFIES HORIZONTAL ALIGNMENT

  .HorizontalAlignment = xlRight
  .VerticalAlignment = xlCenter
  .WrapText = False
  .Orientation = 0
  .AddIndent = False
  .IndentLevel = 0
  .ShrinkToFit = False
  .ReadingOrder = xlContext
  .MergeCells = False






  lRow = lRow + 1
  End With
  Loop
  End With
'  End Sub

'SIX-------------------------------------shrivallabha
'  Sub ChangeFontToCalibri.11()
'  > > > This VBA segment changes the font and font size in Columns A through H from whatever it happens to be to
'  Calibri 11 starting in Row 3.
  Dim wksFnt As Worksheet
  Dim rngFnt As Range
  For Each wksFnt In ActiveWorkbook.Worksheets
  Set rngFnt = Intersect(wksFnt.Range("A3:H" & Rows.Count), wksFnt.UsedRange)
  If Not rngFnt Is Nothing Then
  With rngFnt.Font
  .Size = 11
  .Name = "Calibri"
  End With
  End If
  Next
'  End Sub

'-----------If ws.Cells(Rows.Count, 3).End(xlUp).Row > 2 Then
  End If

'-------If ws.Name <> "Formula Info" And ws.Name <> "Next Tech" Then
  End If

  Next
'BEEPS-----------------------------------
  Beep
'  Pause a second before engaging the next Beep so they don't run together and sound like only one Beep.
  Application.Wait Now + TimeValue("0:00:01")
  Beep
'  Pause a second before engaging the next Beep so they don't run together and sound like only one Beep.
  Application.Wait Now + TimeValue("0:00:01")
  Beep
End Sub

Thanks for your assistance!
 
Last edited:
Please see the completely working VBA code and the commented SEGMENTS A, B, & C, I inserted. I added these segments to Left or Right Justify or Center the text, et. al. I was not sure if I needed to put something in front of the segments, like what you showed me with the .font above (Permalink #20).

As it turns out, it worked with all the added segments and I didn't have to add anything in front. Can you explain why? I'm not used to having new Excel or VBA code work the first time! :DD

Code:
Sub ChangeCase()
' ChangeCase is six VBA modules in one.  See Subs below: TRIMnCLEAN(), ChangeCase(), REDnBOLD(), DateFix(), CurrencyFix()
'  and ChangeFontToCalibri.11().
  Dim ws As Worksheet
  For Each ws In ThisWorkbook.Worksheets
  If ws.Name <> "Formula Info" And ws.Name <> "Dale Purdy" Then
'  If ws.Name <> "Formula Info" And ws.Name <> "Next Tech" Then  Note: to add more just put (And ws.Name <> "name") before Then
'  Change "Formula Info" sheet name or you can use sheet index# instead of name.

  If ws.Cells(Rows.Count, 3).End(xlUp).Row > 2 Then
'  The 3 in (Rows.Count, 3) tells this Subroutine to start in the 3rd row.
'  This line was added to "fix" Error 400 which was caused by blank tab(s).
'  The "Next Tech" tab has no data, and its header is in row 2.
'  The part which returns the last row of data is:  ws.Cells(Rows.Count, 3).End(xlUp).Row
'  which will return 3 or more as long as the worksheet has data; thus subtracting 2 from
'  this value returns any number from 1 upwards.  However, when the worksheet has no data,
'  the above code will return 2, and subtracting 2 from this = 0, which is an invalid row
'  number in Excel.  To check this, we test whether the value returned by the above code
'  is greater than 2; if so, we proceed further, else we exit.
'ONE-------------------------------------
'  Sub TRIMnCLEAN()
  With ws.[A3:D3].Resize(ws.Cells(Rows.Count, 3).End(xlUp).Row - 2)
'  > > > This VBA removes leading and trailing spaces in the array of Columns A through D.
'  A3:D3 array tells where to apply change(s).  (Rows.Count, 3) tells in which column to start.
'  .Value = .Parent.Evaluate(Replace("IF(#>"""",TRIM(#),"""")", "#", .Address)) removes leading and trailing spaces.
'  Added CLEAN to remove leading and trailing ASCII characters 0-31.
  .Value = .Parent.Evaluate(Replace("IF(#>"""",TRIM(CLEAN(#)),"""")", "#", .Address))




'  INSERTED THIS SEGMENT "A" HERE
'  THIS CENTERS VERTICAL ALIGNMENT AND LEFT JUSTIFIES HORIZONTAL ALIGNMENT
   .HorizontalAlignment = xlLeft
  .VerticalAlignment = xlCenter
  .WrapText = False
  .Orientation = 0
  .AddIndent = False
  .IndentLevel = 0
  .ShrinkToFit = False
  .ReadingOrder = xlContext
  .MergeCells = False



  End With
'  End Sub
'TWO-------------------------------------
'  Sub ChangeCase()
  With ws.[E3:F3].Resize(ws.Cells(Rows.Count, 3).End(xlUp).Row - 2)
'  > > > This VBA changes all characters in the array defined by Columns E and F to UPPER case.
'  E3:F3 array tells where to apply change(s).  (Rows.Count, 3) tells in which column to start.
  .Value = .Parent.Evaluate(Replace("IF(#>"""",UPPER(#),"""")", "#", .Address))


'  INSERTED THIS SEGMENT "A" HERE
'  THIS CENTERS VERTICAL ALIGNMENT AND LEFT JUSTIFIES HORIZONTAL ALIGNMENT
   .HorizontalAlignment = xlLeft
  .VerticalAlignment = xlCenter
  .WrapText = False
  .Orientation = 0
  .AddIndent = False
  .IndentLevel = 0
  .ShrinkToFit = False
  .ReadingOrder = xlContext
  .MergeCells = False


  End With
'  End Sub
'THREE----------------------------------- Immediate  ?workbooks.Count  ? application.StartupPath
'  Sub REDnBOLD()
  For Each cll In ws.Range(ws.Cells(3, "C"), ws.Cells(ws.Rows.Count, "C").End(xlUp)).Cells
'  > > > This VBA segment changes the TV Model screen size between 70 and 90 inches to red and Bold and
'  starts in Row 3, Column C, and applies to each tab in the Excel workbook, except for tab "Formula Info" tab.
  With cll
  x = Evaluate("MIN(IFERROR(FIND(ROW(10:99)," & .Address(0, 0, , 1) & "),""""))")
  If x > 0 Then
  y = CLng(Mid(cll.Value, x, 2))
  If y >= 70 And y <= 90 Then
  With .Characters(Start:=x, Length:=2).Font
  .FontStyle = "Bold"
  .Color = -16776961
  End With
  End If
  End If
  End With
  Next cll
'  End Sub
'FOUR-----------------------------------
'  Sub DateFix()
'  constants
'  Const ksFormat = "mm/dd/yyyy"
'  > > > This VBA segment changes the dates in Column G from whatever the format happens to be to "mm/dd/yyyy"
'  declarations
  Dim lRow As Long, iColumn As Integer, lRowest As Long
'  start  1Row starts at row 3, iColumn starts at column G(7)
  lRow = 3
  iColumn = 7
'  process
  With ws
  lRowest = .Cells(.Rows.Count, iColumn).End(xlUp).Row
  Do While lRow <= lRowest
'  Debug.Print lRow
  With .Cells(lRow, iColumn)
'  If Len(.Cells(lRow, iColumn).Value) > 0 Then
  If .NumberFormat <> "mm/dd/yyyy" Then .NumberFormat = "mm/dd/yyyy"






'  INSERTED THIS SEGMENT "B" HERE
'  THIS CENTERS BOTH VERTICAL ALIGNMENT AND HORIZONTAL ALIGNMENT

  .HorizontalAlignment = xlCenter
  .VerticalAlignment = xlCenter
  .WrapText = False
  .Orientation = 0
  .AddIndent = False
  .IndentLevel = 0
  .ShrinkToFit = False
  .ReadingOrder = xlContext
  .MergeCells = False




  lRow = lRow + 1
  End With
  Loop
  End With
'  End Sub
'FIVE------------------------------------
'  Sub CurrencyFix()
'  > > > This VBA segment changes the currency in Column H from whatever the format happens to be to "$#,##0"
'  declarations
  ''  Dim lRow As Long, iColumn As Integer, lRowest As Long
  ''  Dim ws As Worksheet
'  start  1Row starts at row 3, iColumn starts at column H(8)
  lRow = 3
  iColumn = 8
'  process
  With ws
  lRowest = .Cells(.Rows.Count, iColumn).End(xlUp).Row
  Do While lRow <= lRowest
'  Debug.Print lRow
  With .Cells(lRow, iColumn)
'  If Len(.Cells(lRow, iColumn).Value) > 0 Then
  If .NumberFormat <> "$#,##0" Then .NumberFormat = "$#,##0"







'  INSERTED THIS SEGMENT "C" HERE
'  THIS CENTERS VERTICAL ALIGNMENT AND RIGHT JUSTIFIES HORIZONTAL ALIGNMENT

  .HorizontalAlignment = xlRight
  .VerticalAlignment = xlCenter
  .WrapText = False
  .Orientation = 0
  .AddIndent = False
  .IndentLevel = 0
  .ShrinkToFit = False
  .ReadingOrder = xlContext
  .MergeCells = False






  lRow = lRow + 1
  End With
  Loop
  End With
'  End Sub

'SIX-------------------------------------shrivallabha
'  Sub ChangeFontToCalibri.11()
'  > > > This VBA segment changes the font and font size in Columns A through H from whatever it happens to be to
'  Calibri 11 starting in Row 3.
  Dim wksFnt As Worksheet
  Dim rngFnt As Range
  For Each wksFnt In ActiveWorkbook.Worksheets
  Set rngFnt = Intersect(wksFnt.Range("A3:H" & Rows.Count), wksFnt.UsedRange)
  If Not rngFnt Is Nothing Then
  With rngFnt.Font
  .Size = 11
  .Name = "Calibri"
  End With
  End If
  Next
'  End Sub

'-----------If ws.Cells(Rows.Count, 3).End(xlUp).Row > 2 Then
  End If

'-------If ws.Name <> "Formula Info" And ws.Name <> "Next Tech" Then
  End If

  Next
'BEEPS-----------------------------------
  Beep
'  Pause a second before engaging the next Beep so they don't run together and sound like only one Beep.
  Application.Wait Now + TimeValue("0:00:01")
  Beep
'  Pause a second before engaging the next Beep so they don't run together and sound like only one Beep.
  Application.Wait Now + TimeValue("0:00:01")
  Beep
End Sub

Thanks for your assistance!
Some surprises are good. Aren't they? I remember a line which I saw as someone's signature (but I don't remember whose) which says:
I hate when my computer does what I tell it to do rather than want it to do!
So don't just be happy if your code runs without any error. Verify that it meets the requirement.

Just take a look at what you have nested A, B and C with. You have nested them inside ranges i.e. the likes of:
Code:
With .Cells(lRow, iColumn)
which is what the precedent should be, "Excel Range".

Hope this answers your query.
 
Some surprises are good. Aren't they? I remember a line which I saw as someone's signature (but I don't remember whose) which says:
I hate when my computer does what I tell it to do rather than want it to do!
So don't just be happy if your code runs without any error. Verify that it meets the requirement.

Just take a look at what you have nested A, B and C with. You have nested them inside ranges i.e. the likes of:
Code:
With .Cells(lRow, iColumn)
which is what the precedent should be, "Excel Range".

Hope this answers your query.
No doubt there is probably a better code structure that could be made than what I cobbled together, but at this point in time, I'm going for "does it work correctly?" I have not found any errors, yet. It does take about 70 seconds to run, but that's ok. It saves me incalculable time of manual labor. Without going into detail, do you see anything that I could change in the code to make it run faster? Yes or no, would be fine at this point in time. I can ponder over making it faster later.

I performed a "Record Macro" to figure out what lines I needed to know what to put in the code to make the data do what I needed and then put those recorded segments in the existing VBA code and crossed my fingers.

My question, hopefully more to the point, is "why" did it work without putting something like ".font" in front of each segment line? For example, something like .Section? As you can tell, I know just enough about VBA (and Excel) (painfully self-taught with a lot of help from Chandoo folks like yourself) to be dangerous.
 
These 4 lines
Code:
With rngFnt.Font
  .Size = 11
  .Name = "Calibri"
  End With

is the same as two lines

Code:
rngFnt.Font.Size = 11
rngFnt.Font.Name = "Calibri"

but the former version basically says i am modifying two of the rngFnt.Font properties, called Size and Name

In this example either method would be acceptable but in more complex examples the former method is recomended
 
Back
Top