remove duplicated data for multiple columns

1

Hi, experts

so   I  have  this  code   works  very  well  to  delete  duplicated data in COL A,B,C  after  copy  from sheet1  to  sheet2    but  my  question  is   if  I  have  many  columns  about 20 or  more  in sheet1    then  I  have  to   increase  two  lines code  each  column  and  then  the  macro  when  wrriting  it  takes  more  time  and  will  be  containing many   lines   so   if  there  is  way  to  make  the  code shorter  when  I  have  much  columns  then it  will save  for  me  much  time 

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
 sheet1.Range("b2", sheet1.Range("b" & Rows.Count).End(xlUp)).Copy sheet2.Range("b" & Rows.Count).End(xlUp)(2)
 sheet2.Range("b2", sheet2.Range("b" & Rows.Count).End(xlUp)).RemoveDuplicates 1
 sheet1.Range("c2", sheet1.Range("c" & Rows.Count).End(xlUp)).Copy sheet2.Range("c" & Rows.Count).End(xlUp)(2)
 sheet2.Range("c2", sheet2.Range("c" & Rows.Count).End(xlUp)).RemoveDuplicates 1
End Sub

Answer
Discuss

Answers

1
Selected Answer

Leap,

You could loop through all columns in sheet 1 using a counter n which counts until the last used row, as follows:

Sub RemoveDups()
Dim n as Integer
For n = 1 To Sheet1.Cells(2, Columns.Count).End(xlToLeft).Column
    Sheet1.Range(Cells(2, n), Cells(Cells(Rows.Count, n).End(xlUp).Row, n)).Copy
    Sheet2.Cells(2, n).PasteSpecial Paste:=xlPasteValues
    Sheet2.Cells(2, n).EntireColumn.RemoveDuplicates xlYes
Next n

End Sub

Note that this will present columns of uniques values (good if you're making lists for data validation) but removing duplicates for each column may mean you lose combinations of data.

If you have empty columns in sheet 1 (indicated by no value in row 1 say) then the headers should be copied too and a reverse loop used to delete the empty columns. The code becomes this (with key changes shown in bold): 

Sub RemoveDups()
Dim n As Integer
 
For n = 1 To sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
    sheet1.Range(Cells(1, n), Cells(Cells(Rows.Count, n).End(xlUp).Row, n)).Copy
    sheet2.Cells(1, n).PasteSpecial Paste:=xlPasteValues
    sheet2.Cells(1, n).EntireColumn.RemoveDuplicates ' xlYes
Next n
 
' reverse through columns to delete empty ones
For n = sheet2.Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
  If sheet2.Cells(1, n).Value = "" Then sheet2.Cells(2, n).EntireColumn.Delete
Next n
 
End Sub

Hope this helps.

Discuss

Discussion

p.s. You keep spelling Thailand (correct) as Thialand!
John_Ru (rep: 1002) Mar 31, '21 at 9:25 am
John 
many  thanks  for  your  answering   just   i  have  an important question  this  code  it  loops  through all columns ,is  it also  empty columns  ?if  it's  yes  I  need  just  loop  through the  filling columns  contain  data  to  deon't  make  slow  the  code
leap (rep: 12) Mar 31, '21 at 9:49 am
Leap.

You're right, this will loop though the empty columns (until the last "used" coulmn is reached). I don't know how your real data is arranged but (because you weren't overwirting headers in Sheet2) I assumed you as pre-populated Sheet2 row 1.

See my revised answer however. 
John_Ru (rep: 1002) Mar 31, '21 at 10:25 am
John
astonihing!  it's  a big  difference    the  first  code's speed   gives me   57.345
and  the  second   gives  me  0.17
great  work  buddy!
many  thanks  for  your  assistance
leap (rep: 12) Mar 31, '21 at 10:39 am
Okay but I didn't know is was a time trial race! Glad it worked for you.
John_Ru (rep: 1002) Mar 31, '21 at 10:46 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login