HELP - RUN TIME ERROR 13 TYPE MISMATCH - When deleting input from cells

[neonerve]

Hi there,
New to VBA and the forum. Have a little problem. I have entered some VBA code into my spreadsheet that avoids a CURRENCY PRICE being added to a column if the adjacent column DROPDOWN OPTION does not have a value. It pops up an ERROR MSG and then clears the entered value.

Whenever i try to delete a range of cells more than 1 i get the RUN TIME ERROR 13 TYPE MISMATCH.

Any ideas?

Private Sub Worksheet_Change(ByVal Target As Range)

If (Target.Column = 6) And Target <> "" And (Target.Row < 37 And Target.Row > 6) Then
    If Cells(Target.Row, "e").Value = "" Then
        Application.EnableEvents = False
        Target.ClearContents
        Application.EnableEvents = True
        MsgBox "Please select the correct TYPE from the drop down menu"
    End If
End If

If (Target.Column = 8) And Target <> "" And (Target.Row < 37 And Target.Row > 6) Then
    If Cells(Target.Row, "G").Value = "" Then
        Application.EnableEvents = False
        Target.ClearContents
        Application.EnableEvents = True
        MsgBox "Please select the correct TYPE from the drop down menu"
    End If
End If

 

[neonerve]

I have formatted all the columns and drop down options that are references in a different sheet to NUMBER and it still occurs

 

[neonerve]

2 minutes after posting my thread is on page 3... so i assume this may never get answered?

 

[neonerve]

anyone?

 

[StephenCrump]

Welcome to the Forum!

The error is occurring with the comparison Target <> "" when Target contains more than one cell. Instead, you need to compare each cell within Target. One way would be to adapt your code along the following lines:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngToCheck As Range, cell As Range
    Dim bError As Boolean
    
    Application.EnableEvents = False
     
    Set rngToCheck = Intersect(Target, Range("F6:F37"))
    If Not rngToCheck Is Nothing Then
        For Each cell In rngToCheck
            If cell <> "" And cell.Offset(, -1) = "" Then
                bError = True
                cell.ClearContents
            End If
        Next cell
    End If

    'etc for 2nd part 
    
    If bError Then MsgBox "Please select the correct TYPE from the drop down menu"

    Application.EnableEvents = True

End Sub

 

[neonerve]

I'm just about to get stuck into this and try it. Before I do. Is there any way to apply the code across multiple checks without copying in 30 times down the page? The cell that it is checking for data is always adjacent to the one with the data entry.

 

[neonerve]

StephenCrump YOU ARE A SUPERSTAR.... THANK YOU.

 

[StephenCrump]

Is there any way to apply the code across multiple checks without copying in 30 times down the page? The cell that it is checking for data is always adjacent to the one with the data entry.

You could replace this line:

Set rngToCheck = Intersect(Target, Range("F6:F37"))

with

Set rngToCheck = Intersect(Target, Range("F6:F37, H6:H37"))

etc.