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
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
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
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.