VBA - Remove Duplicates + Sort Data

[hrayani]

Hello Friends,

Here is the sample data

	[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]A[/COLOR]​	[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]B[/COLOR]​	[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]C[/COLOR]​	[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]D[/COLOR]​	[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]E[/COLOR]​	[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]F[/COLOR]​	[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]G[/COLOR]​	[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]H[/COLOR]​	[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]I[/COLOR]​	[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]J[/COLOR]​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]1[/COLOR]​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]2[/COLOR]​	5​	5​	5​	5​	5​	5​	5​	5​	5​	5​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]3[/COLOR]​	Article # 1​	Article # 2​	Article # 3​	Article # 4​	Article # 5​	Article # 6​	Article # 7​	Article # 8​	Article # 9​	Article # 10​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]4[/COLOR]​	1​	256​	25​	256​	256​	256​	256​	256​	256​	256​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]5[/COLOR]​	2​	265​	256​	265​	265​	901​	289​	369​	289​	369​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]6[/COLOR]​	10​	298​	265​	289​	289​	925​	298​	901​	298​	901​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]7[/COLOR]​	256​	1237​	298​	298​	298​	987​	365​	925​	365​	925​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]8[/COLOR]​	289​	2365​	1237​	365​	365​	2365​	369​	936​	369​	936​

<tbody>
</tbody>

Worksheet Formulas Cell Formula A2 =COUNTA(A4:A1000) <tbody> </tbody>

<tbody>
</tbody>

I am using below macros to remove duplicates and sort data

Sub removeduplicates()

  ActiveSheet.Range("A4:B1000").removeduplicates Columns:=1, Header:=xlNo
  ActiveSheet.Range("B4:B1000").removeduplicates Columns:=1, Header:=xlNo
  ActiveSheet.Range("C4:C1000").removeduplicates Columns:=1, Header:=xlNo
  ActiveSheet.Range("D4:D1000").removeduplicates Columns:=1, Header:=xlNo
  ActiveSheet.Range("E4:E1000").removeduplicates Columns:=1, Header:=xlNo
  ActiveSheet.Range("F4:F1000").removeduplicates Columns:=1, Header:=xlNo
  ActiveSheet.Range("G4:G1000").removeduplicates Columns:=1, Header:=xlNo
  ActiveSheet.Range("H4:H1000").removeduplicates Columns:=1, Header:=xlNo
  ActiveSheet.Range("I4:I1000").removeduplicates Columns:=1, Header:=xlNo
  ActiveSheet.Range("J4:J1000").removeduplicates Columns:=1, Header:=xlNo
  
End Sub

Sub sort()    
    Range("A4:A1000").sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlNo
    Range("B4:B1000").sort Key1:=Range("B4"), Order1:=xlAscending, Header:=xlNo
    Range("C4:C1000").sort Key1:=Range("C4"), Order1:=xlAscending, Header:=xlNo
    Range("D4:D1000").sort Key1:=Range("D4"), Order1:=xlAscending, Header:=xlNo
    Range("E4:E1000").sort Key1:=Range("E4"), Order1:=xlAscending, Header:=xlNo
    Range("F4:F1000").sort Key1:=Range("F4"), Order1:=xlAscending, Header:=xlNo
    Range("G4:G1000").sort Key1:=Range("G4"), Order1:=xlAscending, Header:=xlNo
    Range("H4:H1000").sort Key1:=Range("H4"), Order1:=xlAscending, Header:=xlNo
    Range("I4:I1000").sort Key1:=Range("I4"), Order1:=xlAscending, Header:=xlNo
    Range("J4:J1000").sort Key1:=Range("J4"), Order1:=xlAscending, Header:=xlNo
    
End Sub

Is there a better way to write the macro.

Further I would like following 2 conditions if possible for both macros.

1) Starting from row # 4 look at the last used cell in each column rather than define range in macro
2) Both macros should remove data & sort data only if more than 8 cells have data in there.

Any help would be appreciated.

Regards,

Humayun

 

[Fluff]

How about

Sub duplicatesremove()
   Dim i As Long
   
   For i = 3 To 24 Step 3
      If Cells(2, i) > 8 Then
         With Cells(5, i - 2).Resize(1000, 2)
            .RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
            .Sort Key1:=Cells(5, i - 2), Order1:=xlAscending, Key2:=Cells(5, i - 1), Order2:=xlAscending, Header:=xlNo
         End With
      End If
   Next i
End Sub

 

[hrayani]

BINGO........ Works Great.

Mine code > hundred lines (all I am capable of is just recording stuff and finding things on net here & there)

Your code > 6 lines

Bunch of thanks...... for being very very helpful

 

[Fluff]

You're welcome & thanks for the feedback

 

[hrayani]

Hi Fluff,

Just noticed one thing.. That every time I run the code some cells gets locked up.. I have only locked cells which have formulas in there

Sub remove_duplicates_sort()
   ActiveSheet.Unprotect
   
  Dim i As Long
   
   For i = 1 To 10
      If Cells(2, i) > 8 Then
         With Cells(4, i).Resize(Cells(2, i))
            .removeduplicates 1, xlNo
            .sort key1:=Cells(4, i), order1:=xlAscending, Header:=xlNo
         End With
      End If
   Next i
       
       ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True
   
End Sub

Is there anything in the code which is causing the cells to lock... I don't see anything

 

[Fluff]

There's nothing there that is changing cells to locked.
But as you are deleting cells the cells below will shift up, so you need to make sure that the entire column is unlocked.

 

[hrayani]

yes the entire column is unlocked.

In fact I selected whole sheet and unlocked all the cells. Then I selected only those cells which have formulas in there.

But when I run the code some unlock cells get locked.....

 

[Fluff]

I can see no reason for that to happen.

 

[hrayani]

I can see no reason for that to happen.

same here