PDA

View Full Version : Solved: conflicting vba Button and select change event



Rob342
06-26-2009, 12:03 PM
Hi All

I have 2 pieces of code on a sheet as per example when a duplicate is entered on 2 rows it goes into the change event ok and works fine, but when i press the command button to delete certain cells it goes into the change event routine again ?
Anybody got any ideas ?
Here is the code:
Private Sub CommandButton1_Click()
'
'delete all data from fields
Range("E5").Select
ActiveCell.ClearContents
Range("J5:L5").Select
ActiveCell.ClearContents
Range("Q5:R5").Select
ActiveCell.ClearContents
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dups As Long
If Target.Areas.Count > 1 Then Exit Sub
With Me.Range("B27:B38")
Dups = Application.WorksheetFunction.CountIf(Me.Range("B27:B38"), Target(1, 1).Value)
If Dups > 1 Then
If MsgBox("RTS Code Duplicated ! Do You Want To Accept The Duplicate ?", vbYesNo) = vbYes Then
ActiveCell.Offset(1, 0).Select
End If
End If
End With
End Sub

p45cal
06-26-2009, 12:21 PM
Dim Block As Boolean
Private Sub CommandButton1_Click()
Block = True
'delete all data from fields
Range("E5").Select
ActiveCell.ClearContents
Range("J5:L5").Select
ActiveCell.ClearContents
Range("Q5:R5").Select
ActiveCell.ClearContents
Block = False
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dups As Long
If Not Block Then
If Target.Areas.Count > 1 Then Exit Sub
With Me.Range("B27:B38")
Dups = Application.WorksheetFunction.CountIf(Me.Range("B27:B38"), Target(1, 1).Value)
If Dups > 1 Then
If MsgBox("RTS Code Duplicated ! Do You Want To Accept The Duplicate ?", vbYesNo) = vbYes Then
ActiveCell.Offset(1, 0).Select
End If
End If
End With
End If
End Sub

Rob342
06-29-2009, 01:46 AM
Thanks p45cal
Works a treat, another question if i want to also check the 1st 5 chars of the string as a duplicate where would the Left(B27,5) code go ?

p45cal
06-30-2009, 12:31 AM
Maybe not the most elegant solution but try replacing:
Application.WorksheetFunction.CountIf(Me.Range("B27:B38"), Target(1, 1).Value)with:
Evaluate("SumProduct(--(LEFT(B27:B38,3)=LEFT(" & Target(1, 1).Address & ",3)))")

Rob342
06-30-2009, 01:35 AM
Thanks p45cal
The code works fine, thanks for your time much appreciated, i can now add some more Msgboxes to chk for certain chars.
Thankyou.

p45cal
06-30-2009, 02:07 AM
in case you didn't notice, I boobed; where you see a 3 by itself in the code, replace it with a 5.