PDA

View Full Version : Preventing duplicates rows



BENSON
12-24-2007, 05:04 AM
The code below copies and pastes data to a spread sheet .I was wondering if it is possible that I could insert some further code to stop the same information being pasted ie if the macro is run twice and the same information is going to be pasted some kind of error message should shoew to indicate a dulplicate row has been pasted.

Thanks

Private Sub Workbook_BeforeClose(Cancel As Boolean)
a = MsgBox("ARE YOU READY TO UPDATE THE HISTORY FILE?", _
vbYesNo)
If a = vbYes Then
Cancel = True
Dim WsTgt As Excel.Worksheet
Dim rngCopy As Excel.Range
Application.ScreenUpdating = False
Set WsTgt = Workbooks("Gardens History.xls").Sheets(1)
With WsTgt.Range("A" & NextEmptyRow(WsTgt))
.Value = Date
.NumberFormat = "ddd dd mmm yy"
' Add C285 and C286
ActiveSheet.Range("C284").Copy
.Offset(, 1).PasteSpecial xlPasteValues
ActiveSheet.Range("C286").Copy
.Offset(, 2).PasteSpecial xlPasteValues
ActiveSheet.Range("C288").Copy
.Offset(, 3).PasteSpecial xlPasteValues

Set rngCopy = ActiveSheet.Range("G260:AZ260")
rngCopy.Copy
.Offset(, 4).PasteSpecial xlPasteValues
Application.ScreenUpdating = True
End With
Else
Rem Cancel = True:Rem If you don't want No=Close
End If
End Sub


Function NextEmptyRow(Wks As Worksheet) As Long
Dim Rng As Range
Set Rng = Wks.Range("A" & Wks.Rows.Count).End(xlUp)
If Rng <> "" Then Set Rng = Rng.Offset(1)
NextEmptyRow = Rng.Row
End Function

Private Sub Workbook_Open()
End Sub

lucas
12-24-2007, 06:54 AM
Alternately you could run a macro to delete all duplicate rows after your code is run...

grichey
12-24-2007, 01:45 PM
a very dirty way to do this would be to have hidden cell that sums all the cells and just checks sum of new vs old info. ie sum A1:Q65 would sum that entire block. Just an idea. You could further refine this any number of ways.

BENSON
12-24-2007, 09:49 PM
The macro to delete duplicate rows sounds good but I would need help in writing it ,also could it be part of the code pasted above ?

THANKS

Aussiebear
12-25-2007, 03:39 AM
G'day Benson, Do a search of this forum for deleting duplicate rows. I found a number of examples which could be used from within your code. :yes

mikerickson
12-25-2007, 11:31 AM
If you are only looking at one row, this should detect if the new on is a duplicate. (This assumes that source G matching destination A indicates a dup.)

If a = vbYes Then
Rem duplicate detection code
If Not (IsError(Application.Match(ActiveSheet.Range("g260"), Workbooks("Gardens History.xls").Sheets(1).Range("A:A"), 0))) Then
MsgBox "Duplicate"
End If


Cancel = True