another set of eyes please

KDS14589

Board Regular
Joined
Jan 10, 2019
Messages
147
Office Version
  1. 2016
Platform
  1. Windows
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'



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
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

JEC

Active Member
Joined
Aug 21, 2021
Messages
488
Office Version
  1. 365
Platform
  1. Windows
First thing I see: Instr returns a number and not text. So "shGE" is not possible.

And I miss an End If. Which causes the error
 

KDS14589

Board Regular
Joined
Jan 10, 2019
Messages
147
Office Version
  1. 2016
Platform
  1. Windows
i just tried but get 'End with out with
 

JEC

Active Member
Joined
Aug 21, 2021
Messages
488
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

You actually miss more End ifs
 

KDS14589

Board Regular
Joined
Jan 10, 2019
Messages
147
Office Version
  1. 2016
Platform
  1. Windows
First thing I see: Instr returns a number and not text. So "shGE" is not possible.

And I miss an End If. Which causes the error
i just now tried but get 'end if without block if
 

JEC

Active Member
Joined
Aug 21, 2021
Messages
488
Office Version
  1. 365
Platform
  1. Windows
Then it's on the wrong place or you still miss one or two
 
Solution

Forum statistics

Threads
1,144,339
Messages
5,723,800
Members
422,517
Latest member
VisioExcel

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
Top