PDA

View Full Version : Solved: How to chk on duplicated cell values & show msg box



Rob342
06-11-2009, 06:57 AM
Hi All,

I have a sheet where a would like to chk the values on cells B28 to B39 too see if the values of any of the above cells are the same.
If the value of any of the cells are the same i would like a msg box to pop up and prompt the user to say " Data Duplicated do you want to continue" yes / no If the user answers yes then delete the cell value above.
eg ; the user enters 79BAA2 in cell B27 then in cell B29 enters the same value 79BAA2 then dlete the value in cell B28.

Hope this makes sense, beign a newbie i am still learning the art of VBA but don't know where to start with this one
Any help would be most appreciated.

Simon Lloyd
06-11-2009, 07:13 AM
Hi All,

I have a sheet where a would like to chk the values on cells B28 to B39 too see if the values of any of the above cells are the same.
If the value of any of the cells are the same i would like a msg box to pop up and prompt the user to say " Data Duplicated do you want to continue" yes / no If the user answers yes then delete the cell value above.
eg ; the user enters 79BAA2 in cell B27 then in cell B29 enters the same value 79BAA2 then dlete the value in cell B28.

Hope this makes sense, beign a newbie i am still learning the art of VBA but don't know where to start with this one
Any help would be most appreciated.Try this in the worksheet code module (right click your worksheet tab and choose view code)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dups As Long
If Target.Cells.Count > 1 Then Exit Sub
With Me.Range("B27:B38")
Dups = Application.WorksheetFunction.CountIf(Me.Range("B27:B38"), Target.Value)
If Dups > 1 Then
If MsgBox("Duplicate found continue?", vbYesNo, "Duplicate detected") = vbYes Then
Target.ClearContents
End If
End If
End With
End Sub

Kenneth Hobs
06-11-2009, 07:20 AM
No, it does not make sense as to why you would delete the middle cell if the top and botom were duplicates.

Similar to Simon's code but you would probably want to stick with his code that just checks the first duplicate. The tradeoff is that multi-cell pastes will not be checked. If you use this code, you would reply NO for a paste where the first duplicate is found and YES for the next duplicate. It is probably not worth it though.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range, iRange As Range
Set iRange = Intersect(Range("B28:B39"), Target)
If iRange Is Nothing Then Exit Sub
For Each cell In iRange
If IsEmpty(cell) Then GoTo nextCell
If WorksheetFunction.CountIf(Range("B28:B39"), cell) > 1 Then
If vbYes = MsgBox("Value is duplicated, clear cell above?", vbYesNo, "Duplicate Exists") Then
cell.Offset(-1, 0).ClearContents
End If
End If
nextCell:
Next cell
End Sub

Rob342
06-11-2009, 07:35 AM
Hi Simon
Thankyou for the response i have input the code and tried it, an error occurs "1004" cannot change part of a merged cell.
Cells B27 to O27 are all merged
Cells B28 To O27 all the way to B39

Can this delete the preceeding line before the duplicate ?

Kenneth Hobs
06-11-2009, 07:40 AM
Merged cells pose special problems unless one knows how to work around those issues. Without knowing such things, we have a hard time helping. This is one reason why forums like this allow file attachments.

Rob342
06-11-2009, 08:11 AM
Ken or Simon
Is there a way to get around the merged cell error,
Cell b28 to o28 is hard coded with if statements so if a certain code is entered on B27 the code is automatically entered with a value, hence reason for deleting it, the same with b30 to o30, b32 to o32,b34 to o34 etc,
I can attatch a copy but the file size is 8Meg ?

Kenneth Hobs
06-11-2009, 08:23 AM
No, we probably don't need it but you can always trim your file to just the relevent part that you need help with. This is usually the best way to get help, keep it simple. :kiss

Rob342
06-11-2009, 09:03 AM
Ken
I have scaled it down as much as i can, otherwise it wont work on the fields we are trying to check.

Kenneth Hobs
06-11-2009, 09:19 AM
What is the password?

Simon Lloyd
06-11-2009, 12:03 PM
Strewth!, merged cells, conflicting code already populating cells and a password protected example - i'm going to lie down!

Rob342
06-12-2009, 03:27 AM
it is a bit of an animal isn't it.
pass = szPswd

Kenneth Hobs
06-12-2009, 05:51 AM
Using Simon's code, it could be tweaked like this.
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("Duplicate found continue?", vbYesNo, "Duplicate detected") = vbYes Then
Target.ClearContents
End If
End If
End With
End Sub

Simon Lloyd
06-12-2009, 11:17 AM
Nice Ken :)

Rob342
06-15-2009, 04:03 AM
Hi Guys
Thanks for all your help so far, we still have error 1004
The problem is that you could have on cell B27 79BAA3 which would bring in the laquer coat on cell B28 which is ok.
When you select the Same RTS 79BAA3 again on cell B29 This is acceptable but it brings in the laquer coat again, if we delete the laquer coat cell this also deletes the hard coded IF statements as well.

Is there a way round it or would it be better to code it all in VBA and have a button to calculate the sheet at the end ?
If so what the best way to start
Ps I Have now a total of 8 Excel books on VBA i will get there in the end.

Simon Lloyd
06-15-2009, 08:44 AM
Well, you originally asked us to not allow a duplicate entry in a cell in a range, which is what our code does, all it does in fact is clear the contents of the cell you just entered data in, it does not clear any other cell nor does it delete anything.

Its possible you need to go back to the drawing board and redesign your workbook so that not only is it more manageable but easier foor you to maintain and understand.

Rob342
06-16-2009, 02:07 AM
Hi Simon

I will take your advice & redesign the sheet to make it easier to under stand, Yours & Kens code works as it should it the sheet that the problem.
I will incorperate your code in the new sheet.

Once again thanks for all your help, maybe i can call on you again in the future.
Regards