PDA

View Full Version : VBA error on clearing cells



nbrown6
11-23-2018, 12:02 PM
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.:banghead:

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
11-24-2018, 11:57 AM
FWIW, it should be .ClearContents with an "s" at the end. I.e.


Target.ClearContents

nbrown6
11-24-2018, 01:38 PM
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
11-24-2018, 03:21 PM
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
11-25-2018, 01:35 PM
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
11-25-2018, 03:05 PM
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
11-25-2018, 03:18 PM
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
11-27-2018, 09:42 AM
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