Copy column data from one sheet to another and delete duplicate entries

oracle259 · Jul 7th 2014

How do I copy data from sheet 1 column A to the first empty cell in sheet 2 column A , check Sheet 2 Column A for any duplicate entries and delete them. I have uploaded a copy the test workbook. The copy & paste function for Sheet 2 should be when the sheet is activated. Thanks

Smallman · Jul 8th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

Hi Oracle

Put this in the Sheet2 Worksheet Object module.

Code

Private Sub Worksheet_Activate()
  Sheet1.Range("A2", Sheet1.Range("A" & Rows.Count).End(xlUp)).Copy Sheet2.Range("A" & Rows.Count).End(xlUp)(2)
  Sheet2.Range("A2", Sheet2.Range("A" & Rows.Count).End(xlUp)).RemoveDuplicates 1
End Sub

Will attach a worksheet to prove workings.

Take care

Smallman

oracle259 · Jul 8th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

Thanks so much. I was trying but just couldn't get it. I tested your code and it does copy and delete the duplicate records but it does not start with the first empty cell in sheet 2 column A thus it may result in blank cells. Is there a way to address that requirement.

Smallman · Jul 8th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

Oracle

If you are trying to say that it does not paste to the first blank cell in Sheet 2 then you may want to check that. This line;

Code

Sheet2.Range("A" & Rows.Count).End(xlUp)(2)

absolutely guarantees that the data hits the first blank cell of sheet2. To prove it step through the code with F8. Been using it for years and it goes like thunder.

Take care

Smallman

**PCI** · Jul 8th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

In sheet1 code

Code

Private Sub Worksheet_Activate()
    Call Treat
End Sub

in a module

Code

Option Explicit


Sub Treat()
Dim WkRg  As Range
Dim Objdic  As Object


Dim F  As Range
    With Sheets("Sheet1")
        .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).Copy _
            Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    End With
        Set WkRg = Sheets("Sheet2").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)


    With CreateObject("Scripting.Dictionary")
        For Each F In WkRg
            .Item(F.Value) = Empty
        Next F
        WkRg.Clear
        Sheets("Sheet2").Cells(2, 1).Resize(.Count, 1) = Application.Transpose(.keys)
    End With
End Sub

Display More

oracle259 · Jul 8th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

Ok. I tested the code again. While it does find the next empty cell if there was a blank cell earlier on it does not fill that first. I have posted the sample workbook to illustrate

Smallman · Jul 8th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

In that case make a minor adjustment to the code;

Code

Private Sub Worksheet_Activate()
    Sheet1.Range("A2", Sheet1.Range("A" & Rows.Count).End(xlUp)).Copy Sheet2.Range("A2").End(xlDown)(2)
    Sheet2.Range("A2", Sheet2.Range("A" & Rows.Count).End(xlUp)).RemoveDuplicates 1
End Sub

Take care

Smallman

oracle259 · Jul 8th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

Thanks so much. I works perfectly. I spent hours trying to figure out how to do this. I cant believe it only took 2 lines of code. Thanks again

Smallman · Jul 8th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

You are most welcome Oracle. See you next time.

Smallman

oracle259 · Jul 8th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

For some reason the following line of code is throwing out a runtime error 1004 is there a work around for this

Code

Sheet1.Range("A2", Sheet1.Range("A" & Rows.Count).End(xlUp)).Copy Sheet2.Range("A2").End(xlDown)(2)

Smallman · Jul 8th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

I don't see what you mean Oracle. The attached shows the code working perfectly with or without a space in sheet 2. You are going to have to be more specific as your concerns appear not to stack up. Post a file.

Take care

Smallman

**PCI** · Jul 8th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

I would suggest

Code

Sheet1.Range("A2:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Copy _
        Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

oracle259 · Jul 8th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

Thanks Smallman. I copied and pasted back the code and its working again. I dont know why it through that error it was working fine before then all i was getting was debug runtime error. Thanks again for your quick reply

oracle259 · Jul 9th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

how can i modify the code below to remove not only the duplicate record but the entire row its in as well

Code

Sheet1.Range("A2:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Copy _Destination:=Sheet2.Range("A2:A" & Rows.Count).End(xlUp).Offset(1, 0)
Sheet2.Range("A2", Sheet2.Range("A" & Rows.Count).End(xlUp)).RemoveDuplicates 1

oracle259 · Jul 9th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

Ok did some more research and combined it with the assistance I got on this forum. Sample Workbook is attached.
Overall, it seems stable and appears to work but needs some error handling for when the primary column to be copied is empty.
Also it takes a while to run so i'm pretty sure its not as efficient as it needs to be.
Any Help with Error Handling and Making the Code more efficient is greatly appreciated, as this is as far as I can take it with my noob skills

Features:

Copy 1 Column from 1 sheet to another
Eliminates duplicate records
Ensures that changes made to primary column are reflected on the other sheet

Code

Option Explicit


Private Sub Worksheet_Activate()
 
Dim LastColumn As Integer
Dim a As Long, b As Long




    ' // Turn off screen updating to increase performance.




      Application.ScreenUpdating = False
    
   
    If Application.WorksheetFunction.CountA(Sheet1.Range("Sheet1!A:A")) < 2 Then
       
    MsgBox ("No Records Created")
    Sheet1.Activate
    
       Else




     ' // Copy over primary key
    
    Sheet1.Range("A2:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row).Copy _
    Destination:=Sheet2.Range("A2:A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ' // Remove duplicate records.
   
  With Application
        
            
       LastColumn = Cells.Find(What:="*", After:=Range("A2"), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 10
     
        
        With Sheet2.Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
             
             ' // Use AdvanceFilter to filter unique values
             
             .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
             .SpecialCells(xlCellTypeVisible).Offset(0, LastColumn - 1).Value = 1
            
            On Error Resume Next
            
            ActiveSheet.ShowAllData
            
            ' // Delete the blank rows
            
           Columns(LastColumn).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
             Err.Clear
         
         End With
         
      '  Columns(LastColumn).Clear
         Application.ScreenUpdating = True
    
      End With
 
    ' // Enable records auto update function.
    
    a = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    b = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
    
    If Application.WorksheetFunction.CountA(Range("Sheet2!$A$2:$A$" & b)) = 0 Then
    
    MsgBox ("Reference Column  Empty")
    
    Else
    
    Sheet2.Range("K2:K" & b).Value = "=Match(A2,Sheet1!$A$2:$A$" & a & ",0)"
    
    On Error Resume Next
    
    With Sheet2.Columns("K")
    Application.ScreenUpdating = False
    Sheet2.Columns("K").SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
    Sheet2.Columns("K").ClearContents
    
    End With
    Application.ScreenUpdating = True
    
    End If




           
    End If
  
End Sub

Display More

**S O** · Jul 9th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

Hi oracle259,

Might I suggest moving this to a new thread? You will probably get more replies as your most recent post no longer reflects what the thread title is asking.

It's good to see people wanting to learn error handling though, far too many people using "On Error Resume Next" these days...

Take Care :smile:

Smallman · Jul 10th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

Oracle

This should help.

Put this in the WS change event. Yourr procedure seems overly complex to me and you should be able to adapt to suit.

Code

Sub test()
Sheet1.Range("A2", Sheet1.Range("A" & Rows.Count).End(xlUp)).Copy Range("A2:A" & Rows.Count).End(xlUp)(2)
Range("A2", Range("A" & Rows.Count).End(xlUp)).Offset(, 1).Formula = "=COUNTIF(A$1:A1,A2)=0"
Range("B2", Range("B" & Rows.Count).End(xlUp)).AutoFilter 1, "FALSE"
Range("B2", Range("B" & Rows.Count).End(xlUp)).EntireRow.Delete
Columns(2).Clear
ActiveSheet.AutoFilterMode = False
End Sub

Take care

Smallman

oracle259 · Jul 10th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

It does execute the copy, checks and deletes duplicates. But it also deletes the data in the first row A2 (A1 contains Headers)

Smallman · Jul 10th 2014

Re: Copy column data from one sheet to another and delete duplicate entries

Oracle

So where it says B2 for the Autofilter change that to B1. Or try something else. It is best for your development that you solve this problem.

Smallman

Copy column data from one sheet to another and delete duplicate entries

Participate now!

Share

Users Viewing This Thread