VBA Autofilter copy values, deduplicate and paste in other sheet

user_10403485 0
Viewed 51

I would like to copy values from column "C" from Sheet1, which are not in Sheet2. As loop is too slow, I added vlookup marking with X missing rows. Then I do autofilter with values X and copy values from column C and paste it to bottom of file in column A. I would like to paste there deduplicated values. Is there way to deduplicate values before pasting to new sheet?

My code currently coping all values:

Sub Copy_Value()

Dim Con As Worksheet
Dim Des As Worksheet
Dim Test As Worksheet
Dim Lastcol As Integer
Dim Lastrow As Integer
Dim Lastrow2 As Integer
Dim i As Long

Application.EnableEvents = False
Application.ScreenUpdating = False
Lastrow = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "C").End(xlUp).Row


Set Res = ThisWorkbook.Sheets("Sheet2")
Set Con = ThisWorkbook.Sheets("Sheet1")
Set copyRange = Con.Range("C2:C" & Lastrow)

Con.Range("L1").AutoFilter Field:=12, Criteria1:="X"
Lastrow2 = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Row

copyRange.SpecialCells(xlCellTypeVisible).Copy Res.Range("A" & Lastrow2 + 1)


End Sub

Thank you

vba excel
1 Answers

RemoveDuplicates is a VBA function that works very fast, and may be a suitable solution for your particular case. Based on the logic of our current code (using an “X” in Col L on Sheet1 to filter) the code below achieves what you want.

Option Explicit
Sub Copy_Value()
Dim LastRow As Long, PasteRow As Long
Application.ScreenUpdating = False

LastRow = Sheet1.Cells(Rows.Count, 3).End(xlUp).Row
PasteRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row + 1

Sheet1.Columns(12).AutoFilter 1, "X"

Sheet1.Range("C2:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy _
Sheet2.Cells(PasteRow, 1)

LastRow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row

With Sheet2.Range("A" & PasteRow & ":A" & LastRow)
    .RemoveDuplicates 1, xlNo    '<~~ xlNo = no header
End With

Sheet1.AutoFilterMode = False
End Sub
Admin1
Related