VBA Type Mismatch

[MissingInAction]

Hi everyone. I'm busy creating an application form for our company that will change based on the selections a user makes. I have VBA code that the MrExcel community helped me with a while ago that works fine with hiding/showing tick boxes.
The first selection the user makes is to pick from a dropdown what type of form he wants, namely "new account", "change account" or "termination of account". If new or change is selected, VBA shows a type mismatch error and highlights

If UCase(Target.Value) = "YES" Then

That is only a part of the code in that line. The full line is

If UCase(Target.Value) = "YES" Then Vis = True Else Vis = False

How can I fix this? I'm still very new to VBA. Here is the full code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Vis As Boolean
    If Target.Address = "$B$7" Then
        Application.ScreenUpdating = False
'        ActiveSheet.Unprotect "abc123"
            If ActiveSheet.Range("B7").Value = "New Account" Then
                Range("C14:E14").Select
'                Performance Contract dropdown
                With Selection.Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:="=Data!$G$2:$G$3"
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = "Select ""Yes"" if the employee does not need any form of IT/phone/alarm code access, otherwise select ""No""."
                    .ErrorMessage = "Please select Yes or No"
                    .ShowInput = True
                    .ShowError = True
                End With
                Range("D7:E7,B15,B26,D9").Select
                Range("B26").Activate
                Selection.Locked = True
                Selection.FormulaHidden = False
                Range("B9:B12,D10:D11").Select
                Range("D11").Activate
                Selection.Locked = False
                Selection.FormulaHidden = False
                Selection.ClearContents
                Range("B8").Select
            Else
                If ActiveSheet.Range("B7").Value = "Termination of Account" Then
'                    ActiveSheet.Unprotect "abc123"
'                    Application.ScreenUpdating = False
                    Range("B9:B12,D7:E7,D9:E11,C14:E14").Select
                    Range("C14:E14").Activate
                    Selection.Locked = False
                    Selection.FormulaHidden = False
                    Range("D9").Select
                    Selection.Locked = False
                    Selection.FormulaHidden = False
                    Range("B9").Select
                    ActiveCell.FormulaR1C1 = _
                        "=IF(R8C2="""","""",IF(R7C2=""Termination of Account"",XLOOKUP(R8C2,'User Data'!C6,'User Data'!C7,""Unknown Employee"")))"
                    Range("B10").Select
                    ActiveCell.FormulaR1C1 = _
                        "=IF(R8C2="""","""",IF(R7C2=""Termination of Account"",XLOOKUP(R8C2,'User Data'!C6,'User Data'!C2,""Unknown Employee"")))"
                    Range("B11").Select
                    ActiveCell.FormulaR1C1 = _
                        "=IF(R8C2="""","""",IF(R7C2=""Termination of Account"",XLOOKUP(R8C2,'User Data'!C6,'User Data'!C8,""Unknown Employee"")))"
                    Range("B12:B13").Select
                    ActiveCell.FormulaR1C1 = _
                        "=IF(R8C2="""","""",IF(R7C2=""Termination of Account"",XLOOKUP(R8C2,'User Data'!C6,'User Data'!C9,""Unknown Employee"")))"
                    Range("D9").Select
                    ActiveCell.Formula2R1C1 = _
                        "=IF(R8C2="""","""",IF(R9C3<>"""",IF(XLOOKUP(R8C2,'User Data'!C6,'User Data'!C11,"""")=0,"""",XLOOKUP(R8C2,'User Data'!C6,'User Data'!C11,"""")),""""))"
                    Range("D10:E10").Select
                    ActiveCell.FormulaR1C1 = _
                        "=IF(R8C2="""","""",IF(R7C2=""Termination of Account"",XLOOKUP(R8C2,'User Data'!C6,'User Data'!C14,""Unknown Employee"")))"
                    Range("D11:E11").Select
                    ActiveCell.FormulaR1C1 = _
                        "=IF(R8C2="""","""",IF(R7C2=""Termination of Account"",XLOOKUP(R8C2,'User Data'!C6,'User Data'!C12,""Unknown Employee"")))"
                    Range("B9:B13,D10:E11").Select
                    Range("D10:E11").Activate
                    Selection.Locked = True
                    Selection.FormulaHidden = False
                    Range("B8").Select
                Else
                    If ActiveSheet.Range("B7").Value = "Change Account" Then
'                        ActiveSheet.Unprotect "abc123"
'                        Application.ScreenUpdating = False
                        Range("B9:B12,D9:D11,C14:E14").Select
                        Range("C14").Activate
                        Selection.Locked = False
                        Selection.FormulaHidden = False
                        Selection.ClearContents
                        Range("B9").Select
                        ActiveCell.FormulaR1C1 = _
                            "=IF(R8C2="""","""",IF(R7C2=""Change Account"",XLOOKUP(R8C2,'User Data'!C6,'User Data'!C7,""Unknown Employee"")))"
                        Range("B10").Select
                        ActiveCell.FormulaR1C1 = _
                            "=IF(R8C2="""","""",IF(R7C2=""Change Account"",XLOOKUP(R8C2,'User Data'!C6,'User Data'!C2,""Unknown Employee"")))"
                        Range("B11").Select
                        ActiveCell.FormulaR1C1 = _
                            "=IF(R8C2="""","""",IF(R7C2=""Change Account"",XLOOKUP(R8C2,'User Data'!C6,'User Data'!C8,""Unknown Employee"")))"
                        Range("B9:B11").Select
                        Range("B9:B11").Activate
                        Selection.Locked = True
                        Selection.FormulaHidden = False
                        Range("B8").Select
                    Else
                        Range("B9:B12,D9:E11").Select
                        Range("D10").Activate
                        Selection.Locked = False
                        Selection.FormulaHidden = False
                        Selection.ClearContents
                        Range("B8").Select
                    End If
                End If
                Range("C14:E14").Select
                With Selection.Validation
                    .Delete
                    .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
                    :=xlBetween
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = True
                    .ShowError = True
                End With
                Range("B8").Select
            End If
'        ActiveSheet.Protect "abc123"
'        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        Application.ScreenUpdating = True
        End If
   
        If Target.Address = "$B$9" Then
            Application.ScreenUpdating = False
            ActiveSheet.Unprotect "abc123"
            If ActiveSheet.Range("B9").Value = "Contract" Or ActiveSheet.Range("B9").Value = "Councillor" Then
                Range("D9:E9").Select
                Range("D9").Activate
                Selection.Locked = False
                Selection.FormulaHidden = False
                Selection.ClearContents
                Range("B10").Select
            Else
                Range("D9:E9").Select
                Range("D9").Activate
                Selection.Locked = True
                Selection.FormulaHidden = False
                Range("B10").Select
            End If
'        ActiveSheet.Protect "abc123"
'        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        Application.ScreenUpdating = True
        End If

    If UCase(Target.Value) = "YES" Then Vis = True Else Vis = False

'   Performance Assist
    If Target.Address = "$B$165" Then
        HiLiteShapes "Perf_", Vis
    End If

'   Eunomia
    If Target.Address = "$D$91" Then
        HiLiteShapes "Eunomia", Vis
    End If

'   Alarm Code & Building Keys
    If Target.Address = "$B$61" Then
        HiLiteShapes "Alarm", Vis
    End If

'   IT Equipment
    If Target.Address = "$E$55" Then
        HiLiteShapes "ITEquip", Vis
    End If
 
'   Risk Management
    If Target.Address = "$B$91" Then
        HiLiteShapes "RiskMan", Vis
    End If
   
'   SDBIP
    If Target.Address = "$B$152" Then
        HiLiteShapes "SDBIPAdmin", Vis
    End If
   
End Sub

Sub HiLiteShapes(MyStr As String, IsVis As Boolean)
    Dim MyShape As Shape
  
    For Each MyShape In ActiveSheet.Shapes
        If Left(MyShape.Name, Len(MyStr)) = MyStr Then
            MyShape.Visible = IsVis
        End If
    Next MyShape
End Sub

Sub RiskMan_Action_Owner_Change()
'   Risk Management - Action Owner
    HiLiteShapes "RiskOwn", Range("G144")
End Sub

Sub SDBIPAdmin_KPI_Owner_Change()
'   SDBIP - KPI Owner
    HiLiteShapes "SDBIPOwn", Range("G156")
End Sub

Thank you

EDIT: Just to add, the code works perfectly. Everything does what it is suppose to do. I just cant figure out why I'm getting the error.

 

[6StringJazzer]

The indentation does not quite follow the code structure so that impairs readability. Once I redo the indentation it became clear that the line of code causing your error is is outside of all If statements. Therefore it is executing every time any cell changes value. What is the address of and content of Target when this error occurs? Is is the dropdown (I assume you mean a cell with data validation using List with a dropdown). I assume you are familiar with navigating Debug mode when the error occurs.

Since this line of code runs no matter what cell changes value, what cell are you trying to check for "YES"?

I am having trouble reproducing an error on that line of code, but the issue is likely in the data. This may be difficult to run down without access to your file.

BTW your code may work but the logical structure has room for improvement. You should using either If/ElseIf/Elseif or Select Case to determine what the Target address and the dropdown value is rather than have a series of independent If statements or If/If/If. The way this code is structured, after the Target address is determined and appropriate code executed, it will continue to test every other possibility anyway.

You also have a number of places where you Select then operate on Selection. This is not a best practice, and tends to crop up when people copy code generated by the macro recorder.

You also refer to ActiveSheet. This code should be in the code module for the relevant sheet, so this reference is unnecessary.

 

[MissingInAction]

I bet there is room for improvement. The only VBA I know is from recording macros and then modifying the code a bit . The issue with changing the code to be more streamlined or aligned with best practices, is that I need to troubleshoot it later if I need to make changes or experience errors. I do not have enough knowledge of VBA, which is why my code might be a bit of a mess.
Where is the indentation incorrect? I'd like to correct it.

What is the address of and content of Target when this error occurs? Is is the dropdown (I assume you mean a cell with data validation using List with a dropdown).

That is correct. The data validation is located at B7.

Since this line of code runs no matter what cell changes value, what cell are you trying to check for "YES"?

There are a few. E55, B61, B139, D139, B152, B165. I think that is all of them.
Here is a link to the file:

Access Application Form (no data) Newest.xlsm

Shared with Dropbox

www.dropbox.com

 

[6StringJazzer]

This is great, thanks for providing a link to your file. What steps do I have to take to see this error occur?

 

[MissingInAction]

Change the dropdown in B7 to "New Account" or "Change Account". "Termination of Account" does not produce the error for some reason.

 

[6StringJazzer]

OK. Your Sub changes other cells on the sheet, which causes the Change event to be triggered again, ad infinitum.

At the very beginning of your code add

Application.EnableEvents = False

then at the end

Application.EnableEvents = True

This is pretty much the standard practice for Sub Worksheet_Change.

That fixes the one error, but I don't know what other problems you may have since I don't really know what else is supposed to happen.

 

[MissingInAction]

That fixed it. Thank you. I did get the same error again when I deleted the "Yes" values from B76 and B77, but I could not reproduce the error and it has not happened again, so I'm not worrying about it at this stage.

 

[MissingInAction]

Hi 6StrongJazzer. I now discovered that the tick boxes I have on my sheet are no longer becoming visible based on a certain cell containing "Yes". These cells are E55, B56:B59, B61, B70:B77, B139, D139, B152 and B165. I have commented out the code you provided, but it made no difference. I also made no changes to the code that control the check boxes. Here is the newest file: Access Application Form (no data) Newest.xlsm

 

[MissingInAction]

Ignore the previous post. Somehow closing the file and opening it again fixed the issue.

 

[MissingInAction]

Hi 6StringJazzer. I'm hoping you can help me again. The error is now constantly cropping up when I delete information. I would fill in test info, then when I delete it, it produces the error. Nothing I do seems to take VBA out of "Break" mode. The only way I can get the code to work again, is if I completely close Excel and open it again. You can highlight cells B8:B12 and delete those (just the delete button, not right click -> delete) to reproduce the error. You can delete other cells and get the same error too though, its not limited to B8:B12.

I have made some changes to the code since last. I have "unnested" the nested ifs, so they are all separate now. This seems to have helped somewhat, but not fix it entirely.
Here is the newest file:

https://www.dropbox.com/scl/fi/cs4v...ata.xlsm?dl=0&rlkey=dvjs77ko7wegnsv1g84vjkuuu

Thank you