"Wrap Cells and Resize": Podcast #1472

[legogeek]

I want to thank Bill for helping me with this, it works very well. However, I have this error come up when I update where the concatenations come from:

run time error 1004 excel macro "unable to set the Size property of the Font class"

I believe it is because I have the sheets protected.
I found a post that deals with that problem but I'm unable to implement it correctly:
http://www.mrexcel.com/forum/showth...le+to+set+the+Size+property+of+the+Font+class
This is what I've tried:

Sheets("your_sheet_name").Unprotect Password:="your_password"
Private Sub Worksheet_Calculate()
	For Each cell In Range("B3:H22")
		Select Case Len(cell.Value)
			Case 0 To 30
				cell.Font.Size = 11
			Case 31 To 40
				cell.Font.Size = 9
			Case 41 To 50
				cell.Font.Size = 8
			Case 51 To 60
				cell.Font.Size = 7
		End Select
	Next cell
End Sub
Sheets("your_sheet_name").Protect Password:="your_password"

When I add the Unprotect/Protect I get a Compile error: Invalid outside procedure.

Am I using this idea Unprotect/Protect correctly or is there another way to solve the first or second error?

 

[Jerry Sullivan]

Hi legogeek,

You're probably right about the protected worksheet being the cause of your first error message.

To get your Protect/Unprotect statements to run correctly you need to move them inside the Sub procedure like this...

Private Sub Worksheet_Calculate()
    Dim Cell As Range
    On Error Resume Next
    Me.Unprotect Password:="your_password"
    For Each Cell In Range("B3:H22")
        Select Case Len(Cell.Value)
            Case 0 To 30
                Cell.Font.Size = 11
            Case 31 To 40
                Cell.Font.Size = 9
            Case 41 To 50
                Cell.Font.Size = 8
            Case 51 To 60
                Cell.Font.Size = 7
        End Select
    Next Cell
   Me.Protect Password:="your_password"
End Sub

Note that we can use "Me" to reference this worksheet because this Calculate Event code is placed inside the worksheet's code module.

 

[legogeek]

Thank You! The idea is working perfectly.

As I am making changes to the original sheet then the code updates. I guess I don't need it to update live but only just before I'm ready to print it or sending it as a pdf.

The calculated sheet is flashing up, calculating, and then returning to the original. Because I'm updating the original sheet manually sometimes 200 entries at a time that will make the entry process really slow - Furthermore, if I apply this code to all the twelve months (One month per sheet - ie January, February, etc...) I'm guessing it will even go slower.

What is a different way to apply the code - not on per calculation basis but rather a "run now" idea?

 

[Jerry Sullivan]

Yes, you can do that.
Below is a macro you can run to update the active sheet only, and another version that update all worksheets.

For Active Sheet Only:

Sub Update_Font_Size_Active_Sheet()
    Dim Cell As Range
    On Error Resume Next
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="your_password"
    For Each Cell In Range("E3:H22")
        Select Case Len(Cell.Value)
            Case 0 To 30
                Cell.Font.Size = 11
            Case 31 To 40
                Cell.Font.Size = 9
            Case 41 To 50
                Cell.Font.Size = 8
            Case 51 To 60
                Cell.Font.Size = 7
        End Select
    Next Cell
   ActiveSheet.Protect Password:="your_password"
End Sub

For All Worksheets:

Sub Update_Font_Size_All_Worksheets()
    Dim Cell As Range
    Dim ws As Worksheet
    On Error Resume Next
    Application.ScreenUpdating = False
    For Each ws In ActiveWorkbook.Worksheets
        With ws
            .Unprotect Password:="your_password"
            For Each Cell In .Range("B3:H22")
                Select Case Len(Cell.Value)
                    Case 0 To 30
                        Cell.Font.Size = 11
                    Case 31 To 40
                        Cell.Font.Size = 9
                    Case 41 To 50
                        Cell.Font.Size = 8
                    Case 51 To 60
                        Cell.Font.Size = 7
                End Select
            Next Cell
            .Protect Password:="your_password"
        End With
    Next ws
End Sub

This last code assumes:
- All worksheets have the same password
- All worksheets have the same cells to update
- You don't have any worksheets you want to skip.

If those assumptions aren't true in your case, the code could be modified as needed.

 

[legogeek]

Jerry, thank you for the help.

One last request - If I have need to only apply the code on tabs such as "January, February, etc...." what would I do?

 

[Jerry Sullivan]

Jerry, thank you for the help.

One last request - If I have need to only apply the code on tabs such as "January, February, etc...." what would I do?

There are a couple of ways to specify a subset of all worksheets. It's usually easiest to do the option that involves the smallest list.
1. Make a list of the ones you want.
2. Make a list of the ones you don't want.

If you have a summary sheet and 12 sheets for months, and you don't expect to add more sheets, I'd suggest option #2.

3. If you will be adding sheets, you can include all sheets that meet a certain criteria like Sales*. In your case you could have a criteria that the sheet name be a valid month name.

Which of those suits your situation the best?

 

[legogeek]

I guess it would be either option 1 or 3. I have several sheets. I also have 12 months all spelled out. January, February, March, April, May, June, July, August, September, October, November, December.

 

[Jerry Sullivan]

Here are some code examples showing the options I mentioned.

Sub All_Worksheets_In_List()
    Dim i As Long
    Dim arrSheetList As Variant
    On Error Resume Next
    
    arrSheetList = Array("January", "February", "March")
   
    For i = 0 To UBound(arrSheetList)
        With Worksheets(arrSheetList(i))
            '---Your code here
        End With
    Next i
End Sub

Sub All_Worksheets_Except()
    Dim ws As Worksheet
    Dim arrExceptions As Variant
    On Error Resume Next
    
    arrExceptions = Array("Summary", "Totals")
   
    For Each ws In ActiveWorkbook.Worksheets
        If Not (IsNumeric(WorksheetFunction.Match(ws.Name, _
                arrExceptions, 0))) Then
            With ws
                '---Your code here
            End With
        End If
    Next ws
End Sub

Sub All_Months()
    Dim i As Long
    On Error Resume Next
 
    For i = 1 To 12
        With Worksheets(Format(i & "/1/2011", "Mmmm"))
            '---Your code here
        End With
    Next i
End Sub

 

[legogeek]

Hey Jerry, I'm back from the Holidays now,

So I think I understand the concept of what your doing. I like the idea of option 3 that you listed.

I'm getting two compile error(s) (Probably because I don't understand VBA as well as a should):
"Expected End Sub" & "For control variable already in use"

Where am I going wrong?

Sub All_Months()
    Dim i As Long
    On Error Resume Next
 
    For i = 1 To 12
        With Worksheets(Format(i & "/1/2011", "Mmmm"))
            Private Sub Worksheet_Calculate()
                 Dim Cell As Range
                 On Error Resume Next
                 Me.Unprotect Password:="bob"
                 For Each Cell In Range("B3:H22")
                     Select Case Len(Cell.Value)
                         Case 0 To 30
                             Cell.Font.Size = 11
                         Case 31 To 40
                             Cell.Font.Size = 9
                         Case 41 To 50
                             Cell.Font.Size = 8
                         Case 51 To 60
                             Cell.Font.Size = 7
                     End Select
                 Next Cell
                Me.Protect Password:="bob"
            End Sub
        End With
    Next i
End Sub

The password was changed to protect the innocent

 

[Jerry Sullivan]

You took the "---Your code here" instruction too literally!
You can't put the entire Sub Procedure in this place, just the parts inside.

Try this untested revision...

Sub All_Months()
    Dim i As Long
    Dim Cell As Range
    On Error Resume Next
 
    For i = 1 To 12
        With Worksheets(Format(i & "/1/2011", "Mmmm"))
                 Me.Unprotect Password:="bob"
                 For Each Cell In Range("B3:H22")
                     Select Case Len(Cell.Value)
                         Case 0 To 30
                             Cell.Font.Size = 11
                         Case 31 To 40
                             Cell.Font.Size = 9
                         Case 41 To 50
                             Cell.Font.Size = 8
                         Case 51 To 60
                             Cell.Font.Size = 7
                     End Select
                 Next Cell
                Me.Protect Password:="bob"
        End With
    Next i
End Sub