Avoid duplicate entries

[Kartyk]

Hi All,

I am trying to copy set of columns from one spreadsheet too a master sheet. I do not want users to copy same data repeatedly.

Hence, I need a code to identify duplicate row ( using a unique ID each row) and update the latest details.

Can someone please suggest a code to do this?

Thanks
Karthik

[snb]

What have you got ?

[Kartyk]

Removeduplicates function, but doesnt seem to work very well. I need foolproof code that ensures latest of duplicate row gets updated.

[snb]

http://www.vbaexpress.com/contact.htm

[SamT]

Guaranteed foolproof code:

Sub Fool()LatestData.Copy 
LastestDuplicateRow.Paste
End Sub

Sorry, that's the best I can do with the information you have provided so far.

How about an example workbook? Below the Advanced Editor is a Manage Attachments button.

[Kartyk]

Hey, no sure if "lastestduplicaterow" is even a function in VBA. I am not getting the prompt.

I am attacing a file that has twi sheets "DB" and "Destination". Data is copied from Destination to DB.WHich is more like a mastersheet.

I would like the macro to identify duplicates (when user clicks update button twice foreg) and avoid entry. Should there be any change in any of the rows, then it should take the latest and update.

HHope it makes sense.

[Kartyk]

Any update pls ? Thanx

[Kenneth Hobs]

I am unclear on some things.

You duplicated the title row. Would that happen normally or something that needs to be coded for?

If an ID is on sheet1 and not in sheet2, then copy that row in sheet1 to the next available row in sheet2?

[SamT]

Looking at the attachment, it appears that all the rows on the Dest sheet are always in every data set on the source sheet. Just copy the last data set. It doesn't really matter if duplicate data is replaced or not as long as it is the latest data.

Or, perhaps your attachment is not a good example of the problem.

Perhaps you have several hundred units.
Perhaps only some of them are updated.
Perhaps there are dates in the data so that any code would know when to stop.
Perhaps one field in in the data will indicate a need to update.

With the scant details you have provided, the best solution I can suggest at this time is to loop thru all the cells in Column 1 on the destination sheet and Find those values on the source sheet starting at A1 in the xlPrevious direction. When the ID is found, copy that row to Destination and loop to the next unit.

This will replace every unit on Destination, even if they have not been updated, but it will always be the latest data for that unit.

If you must not copy duplicate rows, Concatenate the destination Row to a String variable, Concatenate the found source and compare the two before updating. Perhaps one field in in the data will indicate a need to update.

[Kartyk]

Ideally, title should not repeat more than once. Lets assume Column C is the reference or unique ID, my expectation is macro should be able to identify duplicate entries and not allow copying again. However, lets assume, there is a small change in that row and then macro should be able to allow update to the row and not create new row.

Explanation any better ?

[Kenneth Hobs]

I am confused. Do you want to copy to sheets DB or Destination? Your code has copy from Destination to DB.

If source is Destination sheet and target if DB sheet then:

Sub Update()  Dim SourceRange As Range, DestRange As Range
  Dim DestSheet As Worksheet, Lr As Long
  Dim c1 As Range, f1 As Range, r1 As Range
  Dim c2 As Range, f2 As Range, r2 As Range


  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
  End With
  
  Set SourceRange = Sheets("Destination").UsedRange.CurrentRegion
  Set DestSheet = Sheets("DB")
  Set DestRange = DestSheet.UsedRange.CurrentRegion
  Set r2 = DestRange.Rows(DestRange.Rows.Count + 1)  'Next empty row
  
  For Each r1 In SourceRange.Rows
    Set DestRange = DestSheet.UsedRange.CurrentRegion
    Set f2 = DestRange.Find(r1.Cells(, 3))
    If f2 Is Nothing Then
      r2.Value = r1.Value
      Set r2 = DestRange.Rows(DestRange.Rows.Count + 1)  'Next empty row
      'Replace destination row if ID's match but content does not.
      ElseIf Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(r1)), vbTab) _
        <> Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose _
          (Intersect(DestRange, DestSheet.Rows(f2.Row).EntireRow))), vbTab) Then
        Intersect(DestRange, DestSheet.Rows(f2.Row).EntireRow).Value = r1.Value
    End If
NextR1:
  Next r1


 With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlCalculationAutomatic
 End With
End Sub

[SamT]

and not create new row

Well. That is new information. What does it mean.

You know, getting information from you is like pulling hen's teeth. Impossible.

Good bye and good luck with your quest.

[snb]

@ SamT

It confirms my darkest suspicions aired in #4

[SamT]

I try. Hard. But sometimes, I'm just not up for it. IMO, that's my bad. Oh well, I'll live with it.

[Kartyk]

@Kenneth,

Thanks a lot> it works like charm. However, what I dont understand is - data must be copied all at once in one click, at the moment it does not. Took 3 clicks to copy all data.

Otherwise, exactly what I was looking for.

[Kartyk]

gotcha ... Set statement should be placed ahead of r2.value = r1.value ..macro works brilliantly. Thanks foor the help

r2.Value = r1.Value
Set r2 = DestRange.Rows(DestRange.Rows.Count + 1) 'Next empty row

[Kenneth Hobs]

Good for you! I thought it was something like that but did not have time to work it out.