New to VBA, need help with " Compile error: Block If without End If "

[Novelec]

Hi all,

Let me start by saying this is my first post, so I apologize if my etiquette/post format is not 100%, however I will do my best. I've been referencing this forum for a while now and have found it a fantastic source of info, so thanks to all those that contribute, particular the forum veterans.

I was hoping someone could give me some help trouble shooting an error I get as a result of my VBA coding. I have worked with excel for several years, however this is the first project I’ve used VBA, so forgive me if my errors are amateur. I’m not sure if the layout of my code is correct, but I’ve done my best to keep it organised. What I am trying to achieve is centred around a double clicked marlett check box. At work I complete weekly maintenance checks on various parts of my building. When the sheet is opened, a cell containing the item that needs to be inspected has two empty cells next to it. One of the empty cells is a marlett checkbox for if the inspection passes, the other for if it fails.

I’ve used named ranges to refer to groups of check boxes, according to whether they are a pass or fail, and their location in the building. I have written separate codes for the pass and fail check boxes. This is because I am trying to display an input box when the fail option is selected, prompting the user to give reason for the failure. The reason is inserted one cell to the right of the active check box cell. If the user enters nothing, or closes the input box, the check box is cleared. The pass check box will simply check or uncheck when double clicking the cell. I’ve also included code for starting the sheet in a full screen view, but have disabled it until I have finished the workbook.
Can someone help me identify where I’ve gone wrong...? I’ve attached the code below. Any help will be greatly appreciated.
Dan



Option Explicit
Dim User_Fault_Input As String

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' "No" Check Box Command '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

If Target.Count > 1 Then
Exit Sub

If Intersect(Target, Range("Generator_Room_No_Checks, Generator_Control_Room_No_Checks, UPS_2_4_Room_No_Checks, Generator_Main_Switchroom_No_Checks, Lift_Motor_Room_No_Checks")) Is Nothing Then
If Intersect(Target, Range("Main_Corridor_No_Checks, UPS_1_3_5_Room_No_Checks, Battery_Room_No_Checks, UPS_6_7_Room_No_Checks, Fuel_Pump_Room_No_Checks, Undercroft_No_Checks")) Is Nothing Then Exit Sub
End If

Target.Font.Name = "marlett"

If Target.Value <> "a" Then
Target.Value = "a"
Cancel = True
Exit Sub
End If

User_Fault_Input = InputBox("Equipment check unaccebtable - Please enter reason", "Equipment Check Unaccebtable", "Begin typing...")
ActiveCell.Offset(0, 1).Value = User_Fault_Input

If User_Fault_Input = "" Then
Target.ClearContents
Cancel = True
Exit Sub
End If

If Target.Value = "a" Then
Target.ClearContents
Cancel = True
Exit Sub
End If
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' "Yes" Checkbox Command '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

If Target.Count > 1 Then
Exit Sub

If Intersect(Target, Range("Generator_Room_Yes_Checks, Generator_Control_Room_Yes_Checks, UPS_2_4_Room_Yes_Checks, Generator_Main_Switchroom_Yes_Checks, Lift_Motor_Room_Yes_Checks")) Is Nothing Then
Exit Sub
End If

If Intersect(Target, Range("Main_Corridor_Yes_Checks, UPS_1_3_5_Room_Yes_Checks, Battery_Room_Yes_Checks, UPS_6_7_Room_Yes_Checks, Fuel_Pump_Room_Yes_Checks, Undercroft_Yes_Checks")) Is Nothing Then
Exit Sub
End If

Target.Font.Name = "marlett"

If Target.Value <> "a" Then
Target.Value = "a"
Cancel = True
Exit Sub
End If

If Target.Value = "a" Then
Target.ClearContents
Cancel = True
Exit Sub
End If


End Sub
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Sets "Full Screen Mode", and specifies zoom upon activation of Basement Worksheet '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Sub Worksheet_Activate()

'ActiveWindow.Zoom = 122
'Application.DisplayFullScreen = True
'Application.DisplayFormulaBar = False
'ActiveWindow.DisplayWorkbookTabs = False
'ActiveWindow.DisplayHeadings = False
'ActiveWindow.DisplayGridlines = False

End Sub
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'

 

[fhoest]

Try:

If Intersect(Target, Generator_Room_No_Checks,  Generator_Control_Room_No_Checks, UPS_2_4_Room_No_Checks,  Generator_Main_Switchroom_No_Checks, Lift_Motor_Room_No_Checks)) Is  Nothing Then
    If Intersect(Target, Main_Corridor_No_Checks,  UPS_1_3_5_Room_No_Checks, Battery_Room_No_Checks,  UPS_6_7_Room_No_Checks, Fuel_Pump_Room_No_Checks, Undercroft_No_Checks)) Is Nothing Then Exit Sub :end if
    End If

 

[Andrew Poulsom]

It is a named range of cells in a worksheet. In this case (Generator_Room_No_Checks) are marlett check boxes for failed checks in the Generator Room.

You will get the error you are seeing if one or more names don't exist. So check that they do exist.

 

[Novelec]

Thanks for the suggestion Andrew. I've cut back to referencing a single named range, for now whilst trouble shooting. I've changed the code a bit, and now I have the "No" check boxes operating as intended. Now I am finding the "Yes" check boxes do not work. There are no errors to report from the code. All that happens when I click a cell in the "Yes" check box range, is the cursor appears in the cell, rather than performing a marlett check box type action.

I've attached my code below. Would someone be kind enough to instruct me how to post a new code box? I've copied and pasted, then altered the box contents this time...

The assistance so far has helped me greatly, thanks everyone.

Code:



Option Explicit
Dim User_Fault_Input As String


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' "No" Check Box Command '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


If Target.Count > 1 Then
Exit Sub
End If


If Intersect(Target, Range("Generator_Room_No_Checks")) Is Nothing Then
Exit Sub
End If


Target.Font.Name = "marlett"


If Target.Value <> "a" Then
Target.Value = "a"
Cancel = True
User_Fault_Input = InputBox("Equipment check unaccebtable - Please enter reason", "Equipment Check Unaccebtable", "Begin typing...")
ActiveCell.Offset(0, 1).Value = User_Fault_Input
If User_Fault_Input = "" Then
Target.Value = ""
End If
Exit Sub
End If

If Target.Value = "a" Then
Target.ClearContents
Cancel = True
Exit Sub
End If




'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' "Yes" Checkbox Command '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

If Intersect(Target, Range("Generator_Room_Yes_Checks")) Is Nothing Then
Exit Sub
End If


Target.Font.Name = "marlett"


If Target.Value <> "a" Then
Target.Value = "a"
Cancel = True
Exit Sub
End If


If Target.Value = "a" Then
Target.ClearContents
Cancel = True
Exit Sub
End If

End Sub
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'


'Private Sub Worksheet_Activate()


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Sets "Full Screen Mode", and specifies zoom upon activation of Basement Worksheet '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''




'ActiveWindow.Zoom = 122
'Application.DisplayFullScreen = True
'Application.DisplayFormulaBar = False
'ActiveWindow.DisplayWorkbookTabs = False
'ActiveWindow.DisplayHeadings = False
'ActiveWindow.DisplayGridlines = False

'End Sub
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'


</pre>
​

 

[Andrew Poulsom]

You need to double click the cell.

 

[Novelec]

Thanks for the help Andrew, I've tidied up my code, and found my initial problem (ended up being incorrect ordering of my "If" statements). I've managed to get my checks working - Very happy! Now that I have all my check boxes and input boxes working, I have run into another problem...

When my input box populates cells with its user input, it populates more than one. I only want it to populate one cell - At the moment either "Named_Range_2" or "Named_Range_4" will output to both offset locations. Can you instruct me how to order things so "Named_Range_2" will only output to ActiceCell.Offset(0, 1), and "Named_Range_4" will only output to ActiceCell.Offset(0, 3) ?

Please see code below for context. I am guessing I've just ordered statements incorrectly, or some sort of similar amateur mistake... Everyone (Andrew in particular) has provided great assistance so far. It is greatly appreciated...!





<sub>Option Explicit
Dim User_Fault_Input As String

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Count > 1 Then
Exit Sub
End If

If Intersect(Target, Union(Range("Named_Range_1"), Range("Named_Range_2"), Range("Named_Range_3"), Range("Named_Range_4"))) Is Nothing Then
Exit Sub
End If

Target.Font.Name = "marlett"

If Target.Value <> "a" Then
Target.Value = "a"
Cancel = True
If Intersect(Target, Union(Range("Named_Range_1"), Range("Named_Range_3"))) Is Nothing Then
ActiveCell.Offset(0, 1) = ""
End If

If Intersect(Target, Union(Range("Named_Range_2"), Range("Named_Range_4"))) Is Nothing Then
ActiveCell.Offset(0, -1) = ""
End If

If Intersect(Target, Union(Range("Named_Range_2"), Range("Named_Range_4"))) Is Nothing Then
User_Fault_Input = InputBox("Equipment check unaccebtable - Please enter reason", "Equipment Check Unaccebtable", "Begin typing...")

If Intersect(Target, Range("Named_Range_4")) Is Nothing Then
ActiveCell.Offset(0, 3).Value = User_Fault_Input
End If

If Intersect(Target, Range("Named_Range_2")) Is Nothing Then
ActiveCell.Offset(0, 1).Value = User_Fault_Input
End If

If User_Fault_Input = "" Then
ActiveCell.ClearContents
End If
Exit Sub

End If
Exit Sub
End If

If Target.Value = "a" Then
Target.ClearContents
Cancel = True
Exit Sub
End If

End Sub</sub>

 

[Andrew Poulsom]

Don't you need eg?

If Not Intersect(Target, Range("Named_Range_4")) Is Nothing Then

 

[Novelec]

Andrew,

Until your most recent suggestion, I wasn't even aware of the "If Not" function. (Yes, I'm that new...) This has made everything fall into place very easily!

Thanks so much for all your assistance. You've certainly saved me from endless hours of confusion!!!

For anyone interested, this code will give the user a pass/fail-style marlett check box set up. The working code is shown below. Those that are as new as myself: You will need to manipulate the named ranges in the code to suit your own, and will need to change the destination of the user input box to suit your own (See the "Offset" function in code. Google "Excel Offset" to find how this function works).

The code is designed to work with two named ranges (Named Range 1 and Named Range 2), with each of the two ranges representing one column of the users worksheet. Both of these columns should be located relative to the "Offset" amount in the initial range check. In this example, "Pass" check boxes are located in theoretical column "X", and "Fail" check boxes are located one column to the right of the "Pass" boxes. The initial "Offset" functions will clear the opposite box if it is already populated. That is, if the "Pass" check box is already ticked, and the user then ticks the "Fail" box, the macro will first clear the "Pass" check before completing any further action. Additional or alternative pass/fail checks can be added, as with "Named Range 3" and "Named Range 4".

The code has been written by myself, and others are welcome to use it for their own applications, however the usual disclaimers apply: "All care, no responsibility, etc..." The code is working perfectly for my application, however it is the first code I've written, so please excuse any bugs that you find in your own usage.

I'd like to give a very big thank you to Andrew for his assistance, and to all others who have contributed their time and knowledge to solving my dilemma.

Option Explicit
Dim User_Fault_Input As String
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                                                        "Pass/Fail" Check Box Command                                                                              '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
    If Target.Count > 1 Then
    Exit Sub
    End If
 
    If Intersect(Target, Union(Range("Named_Range_1"), Range("Named_Range_2"), Range("Named_Range_3"), Range("Named_Range_4"))) Is Nothing Then
    Exit Sub
    End If
 
    Target.Font.Name = "marlett"
 
    If Target.Value <> "a" Then
        Target.Value = "a"
        Cancel = True
    If Intersect(Target, Union(Range("Named_Range_1"), Range("Named_Range_3"))) Is Nothing Then
        ActiveCell.Offset(0, 1) = ""
    End If
   
    If Intersect(Target, Union(Range("Named_Range_2"), Range("Named_Range_4"))) Is Nothing Then
        ActiveCell.Offset(0, -1) = ""
    End If
    
    If Not Intersect(Target, Union(Range("Named_Range_1"), Range("Named_Range_3"))) Is Nothing Then
        User_Fault_Input = InputBox("Check has been marked unacceptable - Please enter reason", " Check Failed", "Begin typing...")
      
    If Not Intersect(Target, Range("Named_Range_1")) Is Nothing Then
        ActiveCell.Offset(0, 1).Value = User_Fault_Input
    End If
   
    If Not Intersect(Target, Range("Named_Range_3")) Is Nothing Then
        ActiveCell.Offset(0, 3).Value = User_Fault_Input
    End If
   
    If User_Fault_Input = "" Then
        ActiveCell.ClearContents
    End If
    Exit Sub
    End If
    Exit Sub
    End If
   
    If Target.Value = "a" Then
        Target.ClearContents
        Cancel = True
    Exit Sub
    End If
End Sub