I need another set of eyes please.
I had the original code working fine until I added the section ''''''General Worksheets by [index] ascending
(I'm trying to get a list of worksheets that have a CodeName that starts with ShGE)
But after I added it, I get a VBA code error saying 'Expected End With
But I can't find it!!!
Once I have it corrected and going then I can proceed with my 'trial & error'
I had the original code working fine until I added the section ''''''General Worksheets by [index] ascending
(I'm trying to get a list of worksheets that have a CodeName that starts with ShGE)
But after I added it, I get a VBA code error saying 'Expected End With
But I can't find it!!!
Once I have it corrected and going then I can proceed with my 'trial & error'
VBA Code:
Sub Worksheet_Activate()
''''clear & worksheet setup'''
ShGE02.Select
'''clear all cells but keep formulas
Cells.SpecialCells(xlCellTypeConstants).ClearContents
'''cell alignment
Columns("A:BB").HorizontalAlignment = xlHAlignCenter
'''cell color
Cells.Interior.ColorIndex = 44
'''starting point
Range("B1").Select
'''set column width
Columns("A").ColumnWidth = 85
Columns("B").ColumnWidth = 7
Columns("C").ColumnWidth = 3
Columns("D").ColumnWidth = 7
Columns("E").ColumnWidth = 27
Columns("F").ColumnWidth = 14
Columns("g").ColumnWidth = 12
Columns("h").ColumnWidth = 27
Columns("k").ColumnWidth = 7
Columns("l").ColumnWidth = 27
Columns("m").ColumnWidth = 14
Columns("n").ColumnWidth = 12
'''set row hight'''
Rows("3:500").RowHeight = 15.75
''''worksheets list'''''
'Sub WorkSheetList()
Const SwitchBoardName As String = "general.misc"
Const FilterCell As String = "b5"
Const OutputRow As Long = 5
Const IndexClm As String = "c"
Const NameClm As String = "d"
Const VisibleClm As String = "h"
Const CodeNameClm As String = "e"
Dim Sb As Worksheet
Dim Flt As String
Dim TabNames() As String
Dim r As Long
Dim Ws As Worksheet
Dim Rng As Range
Set Sb = ThisWorkbook.Worksheets(SwitchBoardName)
Flt = Sb.Range(FilterCell).Cells(1).Value
ReDim TabNames(ThisWorkbook.Worksheets.Count)
r = OutputRow
[e4] = [{"Name"}]
[f4] = [{"CodeName"}]
[d4] = [{"Index"}]
[g4] = [{"Visibility"}]
''''order by [index] accending by Fluff @ Mr Excell
For Each Ws In ThisWorkbook.Worksheets
If InStr(1, Ws.Name, Flt, vbTextCompare) = 1 Then
Sb.Cells(r, NameClm).Resize(, 4).Value = Array(Ws.Index, Ws.Name, Ws.CodeName, Ws.Visible)
r = r + 1
End If
Next Ws
If r Then
Set Rng = Sb.Range(Sb.Cells(OutputRow, NameClm), Sb.Cells(r - 1, NameClm))
With Sb.Sort
With .SortFields
.Clear
.Add Key:=Rng.Cells(1), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortTextAsNumbers
End With
.SetRange Rng
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'''''General worksheets list'''''
Const SwitchBoardNameG As String = "general.misc"
Const FilterCellG As String = "J5"
Const OutputRowG As Long = 5
Const IndexClmG As String = "K"
Const NameClmG As String = "L"
Const VisibleClmG As String = "M"
Const CodeNameClmG As String = "N"
Dim SbG As Worksheet
Dim FltG As String
Dim TabNamesG() As String
Dim rG As Long
Dim WsG As Worksheet
Dim RngG As Range
Set Sb = ThisWorkbook.Worksheets(SwitchBoardName)
Flt = SbG.Range(FilterCell).Cells(1).Value
ReDim TabNamesG(ThisWorkbook.Worksheets.Count)
rG = OutputRow
[L3] = [{"'General' Worksheets"}]
[L4] = [{"Name"}]
[M4] = [{"CodeName"}]
[K4] = [{"Index"}]
[N4] = [{"Visibility"}]
''''General Worksheets by [index] accending
For Each WsG In ThisWorkbook.Worksheets
If InStr(1, Ws.CodeName, Flt, vbTextCompare) = "ShGE*" Then
Sb.Cells(r, NameClm).Resize(, 4).Value = Array(Ws.Index, Ws.Name, Ws.CodeName, Ws.Visible)
rG = r + 1
End If
Next WsG
If r Then
Set Rng = Sb.Range(Sb.Cells(OutputRow, NameClmG), Sb.Cells(r - 1, NameClmG))
With Sb.Sort
With .SortFields
.Clear
.Add Key:=RngG.Cells(1), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortTextAsNumbers
End With
.SetRange RngG
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
''''namerange list''''
Dim z As Worksheet
Dim n As Integer
Dim nm As Object
Application.ScreenUpdating = False
Set z = ActiveSheet
n = 5
With z
.[h4] = [{"Namerange"}]
For Each nm In ActiveWorkbook.Names
If Left(nm.Name, 5) <> "_xlfn" And nm.Name <> "dropdown.MerchantList" Then
.Cells(n, 8) = nm.Name
n = n + 1
End If
Next nm
''''''Time & Date'''
Dim CurrentTime As String
CurrentTime = TIME
Range("A1").Value = Date & " " & TIME
Range("A1").NumberFormat = ("mmm-dd-yyyy h:mm:ss AM/PM")
''''worksheet name by VBA'''''''''
Range("A3:A4").IndentLevel = 2
Range("A2:A25").HorizontalAlignment = xlLeft
Range("a2") = Name
Range("a3") = Left(Range("a2"), (Application.WorksheetFunction.Find(".", Range("a2"), 1) - 1)) & " - Is the First part up to the separator (.) of the full name and is the division"
Range("a5") = Mid(Range("a2"), (Application.WorksheetFunction.Find(".", Range("a2"), 1) + 1), 256) & " - Is the Last part after the separator (.) of the full name and is the purpose"
Range("a4") = "Then the ('.') separator"
'''''''text replacement for visiblity numbers
Range("g5:g150").Replace What:="-1", Replacement:="Visible"
Range("g5:g150").Replace What:="0", Replacement:="Hidden"
Range("g5:g150").Replace What:="2", Replacement:="VeryHidden"
Range("n5:n150").Replace What:="-1", Replacement:="Visible"
Range("n5:n150").Replace What:="0", Replacement:="Hidden"
Range("n5:n150").Replace What:="2", Replacement:="VeryHidden"
End Sub
