Error when clearing multiple cells in Excel

user_8837495 0
Viewed 119

I'm using Worksheet_Change to make a value (either 1 or 0) appear in the next cell (Bx) when a value is entered in a range of cells (A1:A10).

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
        If Target.Value = 1 Then
            Target.Offset(0, 1).Value = 1 
        Else:
            Target.Offset(0, 1).Value = 0 
        End If
    End If
End Sub

enter image description here

The problem occurs when I try to clear the cells in column A. When I select the cells I want to clear and press "Delete" I get "Run-time error '13' - Type mismatch" on the line "IF Target.Value = 1".

I would also like the cells in the B column to be cleared if I clear cells in the A column. E.g. if I delete cell A2:A5, B2:B5 should be cleared.

From what I understand the problem is that when selecting multiple cells it returns an array as the Target, and this is a mismatch with the Integer.

Is there a way around this problem?

vba excel
2 Answers

Try this. You need to cater for multiple cells in some way, for the reasons you mention, and add an extra clause to your If.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim r As Range, r1 As Range

Set r = Intersect(Target, Range("A1:A10"))

If Not r Is Nothing Then
    For Each r1 In r
        If r1.Value = 1 Then
            r1.Offset(0, 1).Value = 1
        ElseIf r1.Value = vbNullString Then
            r1.Offset(0, 1).Value = vbNullString
        Else
            r1.Offset(0, 1).Value = 0
        End If
    Next r1
End If

End Sub
user_70080440

In a first step we add the functionality that multiple cells are selected and changed:

Private Sub Worksheet_Change_Var1(ByVal Target As Range)
Dim targetCell As Range
    'If Target.Range.count
    If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
        If Target.Cells.Count > 1 Then
            For Each targetCell In Target
            If targetCell.Value = 1 Then
                targetCell.Offset(0, 1).Value = 1
            Else
                targetCell.Offset(0, 1).Value = 0
            End If
            Next targetCell
        Else
            If Target.Value = 1 Then
                Target.Offset(0, 1).Value = 1
            Else
                Target.Offset(0, 1).Value = 0
            End If
        End If
    End If
End Sub

In the 2nd step we understand that also the "one cell" case can be handled in the same way and we add an if clause for the "cell(s) cleared" case:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim targetCell As Range
    'If Target.Range.count
    If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
        For Each targetCell In Target
            If targetCell.Value = 1 Then
                targetCell.Offset(0, 1).Value = 1
            Else
                targetCell.Offset(0, 1).Value = 0
            End If

            'if cell in col A is empty, then clear cell in col B
            If targetCell.Value = "" Then targetCell.Offset(0, 1).ClearContents
        Next targetCell
    End If
End Sub
user_62998480
Related