Displaying sheets with specific column widths.

[cthompson]

Hi All,

I have a macro that displays hidden sheets based on sheet names in a range, and for these sheets it sets the column widths to specific dimensions. This macro runs without problems, but what I am trying to do now is for specific sheet names e.g sheet named "1234" I want to set different column widths.

Below is the macro that i am working with, and at the end of the macro in "red" type is my attempt to identify the one sheet when un-hidden has a different column width than the rest of the sheets. Any suggestions would be appreciated.


Sub Macro1()
'
' Macro1 Macro

Sheets("Table of Contents").Select

Dim s As Worksheet

For Each s In Worksheets
If Not s.Name = "Table of Contents" Then s.Visible = xlSheetHidden
Next s

ActiveWorkbook.Names.Add Name:="Penn", RefersToR1C1:="=Portfolio_Table!R1C16:R100C16"
ActiveWorkbook.Names("Penn").Comment = ""
Dim oneCell


For Each oneCell In Range("Penn")

On Error Resume Next

ActiveWorkbook.Sheets(CStr(oneCell.Value)).Visible = xlSheetVisible

ActiveWorkbook.Sheets(CStr(oneCell.Value)).Visible = xlSheetVisible
ActiveWorkbook.Sheets(CStr(oneCell.Value)).Visible = xlSheetVisible
ActiveWorkbook.Sheets(CStr(oneCell.Value)).Columns("a").ColumnWidth = 22.5
ActiveWorkbook.Sheets(CStr(oneCell.Value)).Columns("b").ColumnWidth = 40.5
ActiveWorkbook.Sheets(CStr(oneCell.Value)).Columns("c").ColumnWidth = 11
ActiveWorkbook.Sheets(CStr(oneCell.Value)).Columns("d").ColumnWidth = 15.5
ActiveWorkbook.Sheets(CStr(oneCell.Value)).Columns("e").ColumnWidth = 30
ActiveWorkbook.Sheets(CStr(oneCell.Value)).Columns("f:g").ColumnWidth = 23.25
ActiveWorkbook.Sheets(CStr(oneCell.Value)).Columns("h:i").ColumnWidth = 13.5
ActiveWorkbook.Sheets(CStr(oneCell.Value)).Columns("j").ColumnWidth = 19
ActiveWorkbook.Sheets(CStr(oneCell.Value)).Columns("k").ColumnWidth = 21.5
ActiveWorkbook.Sheets(CStr(oneCell.Value)).Columns("l:v").ColumnWidth = 15.5
ActiveWorkbook.Sheets(CStr(oneCell.Value)).Columns("w:z").ColumnWidth = 20
ActiveWorkbook.Sheets(CStr(oneCell.Value)).Columns("aa").ColumnWidth = 34
ActiveWorkbook.Sheets(CStr(oneCell.Value)).Columns("ab:ac").ColumnWidth = 15.5

On Error GoTo 0
For ActiveWorkbook.Sheets(CStr(oneCell.Value)) = "1234" To ActiveWorkbook.Sheets(CStr(oneCell.Value)) = "1234"
ActiveWorkbook.Sheets(CStr(oneCell.Value)).Visible = xlSheetVisible
ActiveWorkbook.Sheets(CStr(oneCell.Value)).Columns("a:z").ColumnWidth = 10



Next oneCell

Sheets("Table of Contents").Select

End Sub

 

[mumps]

Maybe:

Sub Macro1()
    Application.ScreenUpdating = False
    Sheets("Table of Contents").Select
    Dim s As Worksheet
    For Each s In Worksheets
        If Not s.Name = "Table of Contents" Then s.Visible = xlSheetHidden
    Next s
    ActiveWorkbook.Names.Add Name:="Penn", RefersToR1C1:="=Portfolio_Table!R1C16:R100C16"
    ActiveWorkbook.Names("Penn").Comment = ""
    Dim oneCell
    For Each oneCell In Range("Penn")
        If Sheets(CStr(oneCell.Value)).Name = "1234" Then
            With Sheets(CStr(oneCell.Value))
               .Visible = xlSheetVisible
               .Columns("a:z").ColumnWidth = 10
            End With
        Else
            On Error Resume Next
            With Sheets(CStr(oneCell.Value))
                .Visible = xlSheetVisible
                .Columns("a").ColumnWidth = 22.5
                .Columns("b").ColumnWidth = 40.5
                .Columns("c").ColumnWidth = 11
                .Columns("d").ColumnWidth = 15.5
                .Columns("e").ColumnWidth = 30
                .Columns("f:g").ColumnWidth = 23.25
                .Columns("h:i").ColumnWidth = 13.5
                .Columns("j").ColumnWidth = 19
                .Columns("k").ColumnWidth = 21.5
                .Columns("l:v").ColumnWidth = 15.5
                .Columns("w:z").ColumnWidth = 20
                .Columns("aa").ColumnWidth = 34
                .Columns("ab:ac").ColumnWidth = 15.5
            End With
            On Error GoTo 0
        End If
    Next oneCell
    Sheets("Table of Contents").Select
    Application.ScreenUpdating = True
End Sub