424 Object Required Error !

J

J_J

Hi,
The below code manages to find if the inputted row is a duplicate of a
previous record and deletes it sucessfully but the VBA compiler gives an
error message as shown on the subject of this message...
Can someone correct the code?
'--------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column >= 3 And Target.Column <= 5 Then ' 3 to 5 stand for C to E
columns

For i = 1 To Target.Row - 1

If (Cells(i, 3) = Cells(Target.Row, 3)) And (Cells(i, 4) =
Cells(Target.Row, 4)) And (Cells(i, 5) = Cells(Target.Row, 5)) Then
MsgBox "Duplicate record!"
Target.EntireRow.Delete
End If

Next

End If

End Sub

'--------------------
Thanks
J_J
 
M

Myrna Larson

If you delete Target.EntireRow, then on the next pass through the loop, the
statement

Cells(Target.Row, 3)

should give an error, since Target doesn't exist any more. If that didn't
cause an error, then the line Target.EntireRow.Delete would, for the same
reason: you've already deleted that row.

Once you delete the row, you should exit the For/Next loop. With minimal
changes to your existing code...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long

If Target.Column >= 3 And Target.Column <= 5 Then
For i = 1 To Target.Row - 1
If (Cells(i, 3) = Cells(Target.Row, 3)) _
And (Cells(i, 4) = Cells(Target.Row, 4)) _
And (Cells(i, 5) = Cells(Target.Row, 5)) Then
MsgBox "Duplicate record!"
Target.EntireRow.Delete
Exit For
End If
Next i
End If
End Sub

But since this is an event macro that runs whenever you make any change to the
worksheet, you need to aim for maximal speed. One of the bottlenecks in VBA is
moving data between a worksheet and VBA, with writing to the worksheet being
worse than reading. In your code, you read from the worksheet 6 times for each
row of data. Not good!

This first modification shows one way to cut down on worksheet accesses by
nesting the IF statements, so you stop checking the row whenever you find a
cell that is different. If the new data is unique, you would have from 2-6
worksheet accesses (average of 4?) for each row above.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long

If Target.Column >= 3 And Target.Column <= 5 Then
For i = 1 To Target.Row - 1
If (Cells(i, 3) = Cells(Target.Row, 3)) Then
If (Cells(i, 4) = Cells(Target.Row, 4)) Then
If (Cells(i, 5) = Cells(Target.Row, 5)) Then
MsgBox "Duplicate record!"
Target.EntireRow.Delete
Exit For
End If
End If
End If
Next i
End If
End Sub

A better approach is to get all of the relevant data from the worksheet with
just 1 read operation. Reading, say, 3000 values from the worksheet takes only
slightly more time than reading 1. Then all of the comparisons are done on the
values that are in VBA's memory space.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim j As Long
Dim R As Long
Dim TheData As Variant

If Target.Column >= 3 And Target.Column <= 5 Then
R = Target.Row
'get all data into a VBA array
TheData = Target.Parent.Cells(1, 3).Resize(R, 3).Value

For i = 1 to R - 1
For j = 3 To 1 Step - 1
'if one value differs, it's not a duplicate,
'no need to check additional columns
If TheData(i, j) <> TheData(R, j) Then Exit For
Next j

'if the loop completed (because all values matched), j = 0
If j = 0 Then
MsgBox "Duplicate record!", vbOKOnly
Application.EnableEvents = False
Target.EntireRow.Delete
Application.EnableEvents = True
Exit For
End If
Next i
End If
End Sub
 
J

J_J

Hi Myrna Larson,

Thank you. Your code works perfectly OK.
I need just a little bit further then this to make it even more effective.

Can we add yet another control to your code so that when we input the
values it will also check columns 3, 4, 5 for a PARTIAL match
(only the "period" (column C value) & "activity" (column D value) data
matches but the "trainer" (column E value) differs) then the program will
warn the user by displaying a message box with the message such as:
"The " & activity & " lesson on " & "period" & "is beeing used by "
& <The found unmatched trainer name> & "Should I remove the old
record and put this new data line to the sheet (Y/N)?"

And if we enter "Y" OR "y" it will do so, but if we enter anything else it
will keep the old record and delete the lastly entered partly matching row?

Hope I have not asked too much

Regards
Sincerely
J_J
 
J

J_J

Hi Don,
I apologise for posting the same question to more then one group. I was only
trying to improve my chances of getting answered within 24 hours. I will not
do it again.
Sincerely
J_J
 
M

Myrna Larson

You can use a variable that indicates which values match. They way I set it
up,

1 = C only
2 = D only
3 = C and D
4 = E only
5 = C and E
6 = D and E
7 = C, D and E


Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim j As Long
Dim k As Long
Dim Matches As Long
Dim R As Long
Dim TheData As Variant

If Target.Column >= 3 And Target.Column <= 5 Then
R = Target.Row
'get all data into a VBA array
TheData = Target.Parent.Cells(1, 3).Resize(R, 3).Value

For i = 1 to R - 1
Matches = 0
k = 1
For j = 1 To 3
If TheData(i, j) = TheData(R, j) Then Matches = Matches + k
k = k * 2
Next j

Select Case Matches
Case 7 'C, D, and E match
MsgBox "Duplicate record!", vbOKOnly
Application.EnableEvents = False
Target.EntireRow.Delete
Application.EnableEvents = True
Exit For
Case 3 'C and D match
'put your new code here
End Select
Next i
End If
End Sub
 
J

J_J

Thank you so much Myrna,
And does something like this below enables us to remove the partly matching
row and let the new line be accepted ? (or maybe replace it?)

'--------------
Case 3 'C and D match
'put your new code here
MsgBox "There is another instructor programmed at this
period&lesson !", vbOKOnly
MsgBox "Would you like to remove it ?", vbOKOnly
Application.EnableEvents = False
' the below line is supposed to be the found partly matching record
TheData(i, j).Row.Delete
Application.EnableEvents = True
Exit For
'--------------------------

Regards
J_J
 
M

Myrna Larson

It won't work as you wrote it. TheData is a VBA array; it contains the data
from the worksheet, but is now totally separate from the worksheet range.

A couple of other points: you are showing two messages boxes; your button for
the 2nd is OK only. Hence the user has no chance to say no. You need just one
box, with buttons for yes and no, and you must capture the response to know
which one to delete. You may want to change the message. Use Chr$(10) to split
it onto separate lines.

Case 3 'C and D match
'remove either the previous row or the target row
Dim Msg As String
Msg = "There is another instructor programmed at this period&lesson!" _
& Chr$(10) & "Click Yes to remove it, No to remove the new entry."
If MsgBox(Msg, vbYesNo) = vbYes Then
'we'll delete the old row: leave i unchanged
Else
'response was No, so remove new entry
i = R
End If

Application.EnableEvents = False
Target.Parent.Rows(i).EntireRow.Delete
Application.EnableEvents = True
Exit For
End Select
Next i
End If
 
J

J_J

Hi Myrna,

Thank you very much indeed. The below code now works perfectly.
I just want to add one more Case to it. This will probably increase the
number of searched Target.Columns. And I guess it will be between
3 and 7. Because in this case I look forward to locate if
there are matches for column "C" and "E" and "G". I know now how to add the
new case codes to the body of

Select Case Matches
.....
.....
End Select

But the logical numbering of the cases and numbers that will be used all
around
the code may be affected. Can you tell me what I should change then?

'----------------------- code starts from here

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim j As Long
Dim k As Long
Dim Matches As Long
Dim R As Long
Dim TheData As Variant

If Target.Column >= 3 And Target.Column <= 5 Then
R = Target.Row
'get all data into a VBA array
TheData = Target.Parent.Cells(1, 3).Resize(R, 3).Value

For i = 1 To R - 1
Matches = 0
k = 1
For j = 1 To 3
If TheData(i, j) = TheData(R, j) Then Matches = Matches + k
k = k * 2
Next j

Select Case Matches

Case 7 'C, D, and E match
MsgBox "Duplicate record!", vbOKOnly
Application.EnableEvents = False
Target.EntireRow.Delete
Application.EnableEvents = True
Exit For


Case 3 'C and D match
'remove either the previous row or the target row
Dim Msg As String
Msg = "Another instructor is scheduled for this period&class !" _
& Chr$(10) & "Yes to remove the old record, No to start all over"
If MsgBox(Msg, vbYesNo) = vbYes Then
'we'll delete the old row: leave i unchanged
Else
'response was No, so remove new entry
i = R
End If

Application.EnableEvents = False
Target.Parent.Rows(i).EntireRow.Delete
Application.EnableEvents = True
Exit For


Case 5 'C and E match
'remove either the previous row or the target row
'Dim Msg As String
Msg = "This period the instructor is scheduled for another lesson ! "
_
& Chr$(10) & "Yes to remove the old record, No to start all over"
If MsgBox(Msg, vbYesNo) = vbYes Then
'we'll delete the old row: leave i unchanged
Else
'response was No, so remove new entry
i = R
End If

Application.EnableEvents = False
Target.Parent.Rows(i).EntireRow.Delete
Application.EnableEvents = True
Exit For

'----------new case goes here
'--------- end finishes here



End Select
Next i
End If

End Sub
'--------------------- that's all

Regards
J_J
 
M

Myrna Larson

You need several changes here. C:E is just 3 columns, C:G is 5.

You need to test the target column for values between 3 and 7 instead of 3 and
5. The column size in the Resize command needs to be 5 instead of 3. The For j
loop should go from 1 to 5 instead of 1 to 3.

With the present scheme, WRT the value of Match, the values that are added are
powers of 2, i.e. 1, 2, 4, 8, 16, 32, 64, etc. (Why you can't just add the
column number: a match on columns 1 and 2 would equal 3, a match on column 3
alone would also equal 3 -- no way to distinguish the two conditions.)

If there's a match on column F, 8 will be added to Matches. If there's a match
on column G, 16 will be added. If columns C, E, and G match, Match will equal
1 + 4 + 16 = 21

But if you discover the need to do yet another column, the value of Matches
will quickly become too confusing to decipher. So I would rework the code as
follows. These changes also eliminate a lot of the duplicate code in the
individual Case blocks.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Long
Dim C1 As Long
Dim C2 As Long
Dim i As Long
Dim j As Long
Dim Matches As String
Dim Msg1 As String
Dim Msg2 As String
Dim R As Long
Dim RemoveRow As Long
Dim TheData As Variant

Constant FirstColumn as string = "C"
Constant LastColumn As String = "G"

C1 = Columns(FirstColumn).Column
C2 = Columns(LastColumn).Column

If Target.Column >= C1 And Target.Column <= C2 Then
R = Target.Row
TheData = Target.Parent.Cells(1, C1).Resize(R, C2 - C1 + 1).Value
Msg2 = Chr$(10) & "Yes to remove the old record, No to start all over."

For i = 1 To R - 1
RemoveRow = 0

Matches = ""
A = Asc(FirstColumn)
For j = 1 To Ubound(TheData, 2)
If TheData(i, j) = TheData(R, j) Then
Matches = Matches & Chr$(A)
End If
A = A + 1
Next j

Select Case Matches
Case ""
RemoveRow = 0

Case "CDE"
Msg1 = "Duplicate record!"
Msgbox Msg1, vbOKonly
RemoveRow = R

Case "CD"
Msg1 = "Another instructor is scheduled for this period & class !"
If MsgBox(Msg1 & Msg2, vbYesNo) = vbYes Then
RemoveRow = i
Else
RemoveRow = R
End If

Case "CE"
Msg1 = "This period the instructor is scheduled for another lesson !"
If MsgBox(Msg1 & Msg2, vbYesNo) = vbYes Then
RemoveRow = i
Else
RemoveRow = R
End If

Case "CEG"
Msg1 = "........"
If MsgBox(Msg1 & Msg2, vbYesNo) = vbYes Then
RemoveRow = i
Else
RemoveRow = R
End If

End Select

If RemoveRow <> 0 Then
Application.EnableEvents = False
Target.Parent.Rows(RemoveRow).EntireRow.Delete
Application.EnableEvents = True
Exit For
End If
Next i
End If
End Sub
 
M

Myrna Larson

PS: If you want to ignore a match in column F, the code needs to be changed to
do that.
 
M

Myrna Larson

I have a typo in this code.

The constant declarations should be

Const FirstColumn as string = "C"
Const LastColumn As String = "G"
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top