"Expected End Sub Error"?

[Ark68]

WHen I compile my VBA project, I get an error with this procedure. It won't even start the procedure, giving me the error "Expected End Sub", with the worksheet reference highlighted. (hightlighted below in blue)
I'm not sure what that error means ... I do have an "End Sub"

Sub open_permit()
    Application.ScreenUpdating = False
    strpath = "D:/WSOP 2020/permit_data.xlsx"
    Workbooks.Open strpath
    Set wb_permit = Workbooks("permit_data.xlsx")
    Set ws_permit = wb_permit.Worksheets("Permit_Data")
    Set ws_cust = wb_permit.Worksheets("Customer_Default")
    If ws_permit.AutoFilterMode Then ws_permit.AutoFilterMode = False
    lrow = ws_permit.Cells(ws_permit.Rows.Count, "A").End(xlUp).Row
    Set rngPermit = ws_fac.Range("A1:BO" & lrow)
    lrow = ws_cust.Cells(ws_cust.Rows.Count, "A").End(xlUp).Row
    Set rngCust = ws_cust.Range("A1:AG" & lrow)
    wb_permit.Windows(1).Visible = False
    Application.ScreenUpdating = True
    ws_front.Unprotect
    With ws_front.Cells(5, 1)
        .Value = "Permit Data"
        .Font.Color = RGB(24, 160, 35) 'green
    End With
    ws_front.Pictures("hidden3").Visible = True
    ws_front.Protect
End Sub

 

[Joe4]

I don't see where you are setting ws_front or ws_fac equal to anything in your code.

 

[Ark68]

Hi Joe,
They are publically declared and set in other modules encountered before this one. When I check the names in the immediate window, they are both identifiable.

This is the code (part) that calls the module ...

. . .
        mbevents = False
        ws_front.Unprotect
        ws_front.Cells(2, 1) = svcDate
        mbevents = True
        ws_front.Protect
        svcNum = 1
        open_data
        open_fac
        open_permit
        pop_staff
        svcNum = 0
. . .

The previous module, "open_fac" is essentially written the same as "open_permit" yet it doesn't pose any issues ...

Sub open_fac()
    Stop
    Application.ScreenUpdating = False
    strpath = "D:/WSOP 2020/SupportData/Facilities.xlsx"
    Workbooks.Open strpath
    Set wb_fac = Workbooks("Facilities.xlsx")
    Set ws_fac = wb_fac.Worksheets("Facilities")
    lrow = ws_fac.Cells(ws_fac.Rows.Count, "A").End(xlUp).Row
    Set rngFac = ws_fac.Range("A1:Q" & lrow)
    wb_fac.Windows(1).Visible = False
    Application.ScreenUpdating = True
    ws_front.Unprotect
    With ws_front.Cells(4, 1)
        .Value = "Facilities Data"
        .Font.Color = RGB(24, 160, 35) 'green
    End With
    ws_front.Pictures("hidden2").Visible = True
    ws_front.Protect
    Stop
End Sub

 

[Joe4]

That makes no sense to me then why that worksheet reference would be highlighted, especially since you already used it in the line above, and you already ran an Unprotect command on it earlier in the code.

I would recommend putting a break in your code near the top of the procedure giving you issues, and then stepping into your code and running it one line at a time (using the F8 key) while watching what is happening to your workbook. It could be that some other automated code is being invoked and moving you somewhere else. Running the code one line at a time while watching what happens would make that obvious.

 

[Ark68]

Thanks Joe, it's odd.
I tried your suggestion by putting a break at the top of the troublesome procedure, but it doesn't get to that point. As soon as the procedure is called, the code breaks with the error. The start of the procedure gets hightlighted yellow, but as soon as I press F8, it errors to that line.
Maybe a system restart will fix it lol?

 

[Joe4]

Thanks Joe, it's odd.
I tried your suggestion by putting a break at the top of the troublesome procedure, but it doesn't get to that point. As soon as the procedure is called, the code breaks with the error. The start of the procedure gets hightlighted yellow, but as soon as I press F8, it errors to that line.
Maybe a system restart will fix it lol?

Which line of code gets highlighted, and what is it still the "Expected End Sub" error message?

If so, please post ALL the code in that particular module. You may have an error in another procedure that is confusing Excel regarding where the other procedures start and stop.

 

[Ark68]

Even when I comment out the "offending line", it still throws the error.
If I delete the line, the error gets thrown at the end of the last line before the procedure's "End Sub". It's like "End Sub" isn't even there.
Something is haunted. If I delete the end sub line, or the whole module, Excel crashes.

 

[Ark68]

Which line of code gets highlighted, and what is it still the "Expected End Sub" error message?

If so, please post ALL the code in that particular module. You may have an error in another procedure that is confusing Excel regarding where the other procedures start and stop.

Hightlighted when I step through? "Sub open_permit", and hitting F8 at that point triggers the same error and hightlights (in black) the last line of code before the End Sub line.

 

[Joe4]

Hightlighted when I step through? "Sub open_permit", and hitting F8 at that point triggers the same error and hightlights (in black) the last line of code before the End Sub line.

Please post ALL the code in the procedure, like I asked.
Also, if you have code in the Worksheet module, we may need to see that too.

Do you put/use "Option Explicit" in all your modules? If not see this: Option Explicit in Excel VBA
I would recommend using that ALWAYS. It will force you to declare all your variables before using them, and help catch certain errors, like typos.

So I would recommend doing that (if haven't already), compiling your VBA code (by selecting "Compile VBAProject" under the "Debug" menu), and fixing all the issues it finds.
Whenever you get errors, running that Compile step is a good thing to do to help locate issues.

 

[Ark68]

Hi Joe, thanks for your help. I've worked through the errors revealed through the inclusion of Option Explict and compiled my code. The only error existing is the "Expected end sub error" the subject of this post.

The only worksheet code I have resides in the worksheets("Front") - ws_front - worksheet.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim zdate As Boolean
Dim svcNum As Double
Dim ui1 As String

If Target.Address = "$A$1" Then
    'Stop
    If Not mbevents Then Exit Sub
    zdate = IsDate(ws_front.Cells(1, 1))
    If zdate = False Then
        MsgBox "Please enter a date.", vbInformation, "Invalid entry"
        mbevents = False
        ws_front.Cells(1, 1) = "Enter Date"
        mbevents = True
    Else
        'MsgBox "Valid date.", vbInformation, "Valid entry"
        svcDate = ws_front.Cells(1, 1)
        mbevents = False
        ws_front.Unprotect
        ws_front.Cells(2, 1) = svcDate
        mbevents = True
        ws_front.Protect
        svcNum = 1
        open_data
        open_fac
        'Stop
        open_permit
        pop_staff
        svcNum = 0
        ui1 = InputBox("Select: " & Chr(13) & _
            "(1)   Diamonds" & Chr(13) & _
            "(2)   Fields" & Chr(13) & _
            "(3)   Courts" & Chr(13) & _
            "(4)   Trails" & Chr(13) & _
            "(5)   Passive", "Setup Sheet Compilation", "3")
        If ui1 = "1" Then
            pop_Dsvc svcNum
        ElseIf ui1 = "2" Then
            pop_Fsvc svcNum
        ElseIf ui1 = "3" Then
            MsgBox "Future"
            Exit Sub
        ElseIf ui1 = "4" Then
            MsgBox "Future"
            Exit Sub
        Else
            pop_Dsvc svcNum
            pop_Fsvc svcNum
            'pop_Csvc svcNum
            'pop_Tsvc svcNum
            'pop_Psvc svcNum
        End If
    End If
End If

End Sub

This is all the code in the module holding the procedure that is being troublesome.

Public pdaStart As Double
Public pdaEnd As Double
Public rngpda As Range
Public wb_fac As Workbook
Public ws_fac As Worksheet
Public wb_permit As Workbook
Public ws_permit As Worksheet
Public ws_cust As Worksheet
Public rngFac As Range
Public rngPermit As Range
Public rngCust As Range
Option Explicit
'Stop
Sub open_data()
    Dim dt As String
    Dim strmn As String, strfn As String, strsdir As String, strpath As String
    Dim day1 As String
    Dim day2 As String
    Dim it, x As Long
    Dim cntdia As Long, cntfld As Long, cntcrt As Long, cnttrl As Long, cntpsv As Long
    
       
    Application.ScreenUpdating = False
    strmn = MonthName(Month(svcDate))
    day1 = UCase(Format(svcDate, "ddd"))
    day2 = Format(Day(svcDate), "00")
    dt = Format(svcDate, "dd-mmm-yy")
    strfn = "WS " & dt & ".xlsx"
    strsdir = day2 & " " & day1
    strpath = "D:/WSOP 2020/Distributables/" & strmn & "/" & strsdir & "/" & strfn
    
    Workbooks.Open strpath
    Set wb_data = Workbooks(strfn)
    Set ws_master = wb_data.Worksheets("Master")
    Workbooks(strfn).Windows(1).Visible = False
    Application.ScreenUpdating = True
    ws_front.Unprotect
    With ws_front.Cells(3, 1)
        .Value = strfn
        .Font.Color = RGB(24, 160, 35) 'green
    End With
    ws_front.Pictures("hidden1").Visible = True
    ws_front.Protect
'Stop
    With ws_master
        'create original backup
        Dim sht As Workbook
        
        For Each sht In wb_data.Worksheets
            Application.DisplayAlerts = False
            If sht.Name = "Master_ORIG" Then wb_data.Worksheets("Master_ORIG").Delete
            Application.DisplayAlerts = True
        Next sht
        Workbooks(strfn).Windows(1).Visible = True
        .Copy After:=.Parent.Sheets(.Parent.Sheets.Count)
        ActiveSheet.Name = "Master_ORIG"
        Workbooks(strfn).Windows(1).Visible = False
        pdaStart = 13
        pdaEnd = (WorksheetFunction.Match("Facility Maintenance Activities", .Columns(1), 0) - 3)
        Set rngpda = .Range("A" & pdaStart & ":R" & pdaEnd)
        cntdia = WorksheetFunction.CountIf(.Columns(18), "D")
        cntfld = WorksheetFunction.CountIf(.Columns(18), "F")
        cntcrt = WorksheetFunction.CountIf(.Columns(18), "C")
        cnttrl = WorksheetFunction.CountIf(.Columns(18), "T")
        cntpsv = WorksheetFunction.CountIf(.Columns(18), "P")
       
        'unmerge ops cells
        For Each it In .Range("H13:P" & .Range("H" & Rows.Count).End(xlUp).Row)
            x = it.MergeArea.Count
            If x > 1 Then it.UnMerge: it.Resize(, x) = it
        Next
    End With
        
    With ws_front
        .Unprotect
        .Range("R3") = cntdia + cntfld + cntcrt + cnttrl + cntpsv
        .Range("AA2") = cntdia
        .Range("AA3") = cntfld
        .Range("AA4") = cntcrt
        .Range("AI2") = cnttrl
        .Range("AI3") = cntpsv
        .Protect
    End With

    If ws_front.Range("R3") > 100 Then
        MsgBox "The number of bookings exceeds the capacity of this application." & Chr(13) & "(Maximum 100 bookings)", vbCritical, "Booking Capacity Exceeded"
        Stop
    End If
    'Stop
End Sub

Sub open_fac()
    Dim strpath As String
    Dim lrow As Integer
    
    'Stop
    Application.ScreenUpdating = False
    strpath = "D:/WSOP 2020/SupportData/Facilities.xlsx"
    Workbooks.Open strpath
    Set wb_fac = Workbooks("Facilities.xlsx")
    Set ws_fac = wb_fac.Worksheets("Facilities")
    lrow = ws_fac.Cells(ws_fac.Rows.Count, "A").End(xlUp).Row
    Set rngFac = ws_fac.Range("A1:Q" & lrow)
    wb_fac.Windows(1).Visible = False
    Application.ScreenUpdating = True
    ws_front.Unprotect
    With ws_front.Cells(4, 1)
        .Value = "Facilities Data"
        .Font.Color = RGB(24, 160, 35) 'green
    End With
    ws_front.Pictures("hidden2").Visible = True
    ws_front.Protect
    'Stop
End Sub

Sub open_permit()
    Dim strpath As String
    Dim lrow As Integer
    
    Set ws_front = Workbooks("Diamond_Test.xlsm").Worksheets("Front")
    Application.ScreenUpdating = False
    strpath = "D:/WSOP 2020/permit_data.xlsx"
    Workbooks.Open strpath
    Set wb_permit = Workbooks("permit_data.xlsx")
    Set ws_permit = wb_permit.Worksheets("Permit_Data")
    Set ws_cust = wb_permit.Worksheets("Customer_Default")
    If ws_permit.AutoFilterMode Then ws_permit.AutoFilterMode = False
    lrow = ws_permit.Cells(ws_permit.Rows.Count, "A").End(xlUp).Row
    Set rngPermit = ws_fac.Range("A1:BO" & lrow)
    lrow = ws_cust.Cells(ws_cust.Rows.Count, "A").End(xlUp).Row
    Set rngCust = ws_cust.Range("A1:AG" & lrow)
    wb_permit.Windows(1).Visible = False
    Application.ScreenUpdating = True
    ws_front.Unprotect
    With ws_front.Cells(5, 1)
        .Value = "Permit Data"
        .Font.Color = RGB(24, 160, 35) 'green
    End With
    ws_front.Pictures("hidden3").Visible = True
    ws_front.Protect
End Sub

Maybe this will help. Otherwise, I think we can agree the file is likely corrupt and may not ber able to be fixed.