3

I want create a worksheet that has a number of properties, e.g. columns that only accept number entries and columns that only accept values from drop down lists. I have created a VBA script which works almost perfectly however I have one problem I can't solve which seems to be related to the IsEmpty() function.

At the moment, in columns C, D and H I can only enter values form the drop down list and my error message ("Please select value from drop-down list") is thrown otherwise (including if values are pasted in). The IsEmpty() function call allows values to be deleted without throwing errors.

In the Value_Columns range, again I can only enter values and these are formatted correctly. If I delete the value in a single cell, the IsEmpty() function behaves normally, and the value is cleared. However, if I select a range of cells (e.g. I5:I10) and press delete, the following error message is thrown:

Entry must be a number

This is in contrast to columns C, D and H, where deleting a range of cell contents throws no error message.

I can't see any reason why this behaviour appears to be inconsistent. Can anyone help?

Sub Worksheet_Change(ByVal Target As Range)

Dim Industry_Column As Range
Dim Proposition_Column As Range
Dim Status_Column As Range
Dim Value_Columns As Range

Set Industry_Column = Range("C5:C500")
Set Proposition_Column = Range("D5:D500")
Set Status_Column = Range("H5:H500")
Set Value_Columns = Range("I5:W500")

If Not IsEmpty(Target) Then

    If Not Application.Intersect(Target, Industry_Column) Is Nothing Then

        If IsError(Application.Match(Target, Worksheets("Drop Down Lists").Range("A2:A6"), 0)) Then
            Application.EnableEvents = False
            Application.Undo
            MsgBox "ERROR - Please select value from drop-down list"
            Application.EnableEvents = True

        End If

    ElseIf Not Application.Intersect(Target, Proposition_Column) Is Nothing Then

        If IsError(Application.Match(Target, Worksheets("Drop Down Lists").Range("C2:C6"), 0)) Then
            Application.EnableEvents = False
            Application.Undo
            MsgBox "ERROR - Please select value from drop-down list"
            Application.EnableEvents = True

        End If

    ElseIf Not Application.Intersect(Target, Status_Column) Is Nothing Then

        If IsError(Application.Match(Target, Worksheets("Drop Down Lists").Range("E2:E6"), 0)) Then
            Application.EnableEvents = False
            Application.Undo
            MsgBox "ERROR - Please select value from drop-down list"
            Application.EnableEvents = True

        End If

    ElseIf Not Application.Intersect(Target, Value_Columns) Is Nothing Then

        If Not IsNumeric(Target) Then
            Application.EnableEvents = False
            Application.Undo
            MsgBox "ERROR - Entry must be a number"
            Application.EnableEvents = True

        Else

            Target.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "

        End If

    End If

End If

End Sub

1 Answer 1

1

If you look on the definition of IsEmpty() https://msdn.microsoft.com/en-us/library/office/gg264227.aspx it indicate it work on an expression

When you do If Not IsEmpty(Target) Then VBA implicitly cast it If Not IsEmpty(Target.Value) Then and Range.Value is an expression. So a standalone range can be considered an expression.

But in your case, the implicit cast to expression don't work. You'll have to create a fonction that look if all cells are empty.

Implement and replace your IsEmpty() by the following IsRangeEmpty() and it will work

' Return if a range is empty
Private Function IsRangeEmpty(ByVal rng As Range) As Boolean
    Dim cell As Range
    ' for each cell in the range
    For Each cell In rng
        ' if a cell is not empty
        If Not IsEmpty(cell) Then
            ' return "not empty"
            IsRangeEmpty = False
            Exit Function
        End If
    Next

    ' Here all cells are empty
    IsRangeEmpty = True
End Function
Sign up to request clarification or add additional context in comments.

1 Comment

Thanks very much for the explanation! I have tried your function and that works perfectly.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.