VBA error on clearing cells

[nbrown6]

Hi All,

Sorry, my question is probably very basic. but i cannot seem to get my head around what im missing.

I have a very simple piece of code that simply inputs a time in the second column when the first has a scanned entry and simply works when a cell is changed. This worked great until i wanted to remove duplicate entries after they had been entered.

I have another piece of code that simply clears the contents in the A and B columns when i want to to. But now i have added the countif and clearcontent part, i get a mismatch error.

Is there a better way to do it?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Integer


If Application.CountIf(Range("A:A"), Target) > 1 Then           'check if the number already exists
Target.clearcontent                                             'clear contents if number exists
ActiveSheet.Cells(Sheets("lists").Range("a9") + 1, 1).Select    'select the next empty cell
End If


For x = 2 To 1000
If Cells(x, 1).Value <> "" And Cells(x, 2).Value = "" Then
    Cells(x, 2).Value = time()                              'Add the time to the cell if it changes


    Beep            'make a sound!


End If
Next
End Sub

[rlv]

FWIW, it should be .ClearContents with an "s" at the end. I.e.

Target.ClearContents

[nbrown6]

FWIW, it should be .ClearContents with an "s" at the end. I.e.

Target.ClearContents

Good spot. The code i am actually using has the S.

The line the Debug points me to is

If Application.CountIf(Range("A:A"), Target) > 1 Then

[rlv]

Welcome to VBAExpress. I pasted what you posted into my debugger and I don't get any error at that line. It would be better if you could attach a small workbook that we can test, which demonstrates the error you are getting.

[nbrown6]

Welcome to VBAExpress. I pasted what you posted into my debugger and I don't get any error at that line. It would be better if you could attach a small workbook that we can test, which demonstrates the error you are getting.

Thanks for looking. Good idea, hopefully the example should be attached.

The code runs perfectly until i clear the cells at the end.

[david000]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Integer
On Error GoTo Xit '< skip the whole event
If Application.CountIf(Range("A:A"), Target) > 1 Then           'check if the number already exists
Target.ClearContents                                             'clear contents if number exists
ActiveSheet.Cells(Sheets("lists").Range("I2") + 1, 1).Select    'select the next empty cell
End If
For x = 2 To 1000
If Cells(x, 1).Value <> "" And Cells(x, 2).Value = "" Then
    Cells(x, 2).Value = Time()                              'Add the time to the cell if it changes
    Beep            'make a sound!
End If
Next
Xit: '< to here and leave the routine without running
End Sub

[rlv]

The error comes when the range "Target" is more than one cell. Here's one way to deal with that.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x As Integer
    Dim LR As Integer

    If Not Application.Intersect(Target, Range("A:A")) Is Nothing And Target.Cells.Count = 1 Then 'only execute if changed cell is in column A and is just a single cell
        If Application.CountIf(Range("A:A"), Target) > 1 Then    'check if the number already exists
            Target.ClearContents                      'clear contents if number exists
            'ActiveSheet.Cells(Sheets("lists").Range("I2") + 1, 1).Select    'select the next empty cell
            ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1).Select
        End If

        LR = Cells(Rows.Count, "A").End(xlUp).Row     'determine last row for time add
        If LR < Cells(Rows.Count, "B").End(xlUp).Row Then
            LR = Cells(Rows.Count, "B").End(xlUp).Row
        End If

        For x = 2 To LR
            If Cells(x, 1).Value <> "" Then
                If Cells(x, 2).Value = "" Then
                    Cells(x, 2).Value = Time()        'Add the time to the cell if it changes
                    Beep                              'make a sound!
                End If
            Else
                Cells(x, 2).Value = "" 'else clear the time value
            End If
        Next
    End If
End Sub

[nbrown6]

The error comes when the range "Target" is more than one cell. Here's one way to deal with that.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x As Integer
    Dim LR As Integer

    If Not Application.Intersect(Target, Range("A:A")) Is Nothing And Target.Cells.Count = 1 Then 'only execute if changed cell is in column A and is just a single cell
        If Application.CountIf(Range("A:A"), Target) > 1 Then    'check if the number already exists
            Target.ClearContents                      'clear contents if number exists
            'ActiveSheet.Cells(Sheets("lists").Range("I2") + 1, 1).Select    'select the next empty cell
            ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Offset(1).Select
        End If

        LR = Cells(Rows.Count, "A").End(xlUp).Row     'determine last row for time add
        If LR < Cells(Rows.Count, "B").End(xlUp).Row Then
            LR = Cells(Rows.Count, "B").End(xlUp).Row
        End If

        For x = 2 To LR
            If Cells(x, 1).Value <> "" Then
                If Cells(x, 2).Value = "" Then
                    Cells(x, 2).Value = Time()        'Add the time to the cell if it changes
                    Beep                              'make a sound!
                End If
            Else
                Cells(x, 2).Value = "" 'else clear the time value
            End If
        Next
    End If
End Sub

Cheers Guys. This one worked perfectly.

For some reason it was really slow in my program, but once i removed the table it was acting on, it worked perfectly!

Thanks again