Excel to remove duplicates one column at a time for many columns

Question

I have an Excel workbook with many sheets(40+) which have many columns in each(30+).

My goal is to remove duplicates in each column but not based on any other column

Answer 1

Here is some code to get you started.

What I did was first created a simple list with some duplicates. I used the macro recorder (Developer --> Record Macro).

I selected the list and then went to Data --> Remove Duplicates.

I stopped recording to see this code:

Range("A1:A11").Select
ActiveSheet.Range("$A$1:$A$11").RemoveDuplicates Columns:=1, Header:=xlNo

I adapted the .RemoveDuplicates method to loop through worksheets as such:

Sub RemoveDups()
        Dim ws As Worksheet
        Dim col As Range

        For Each ws In ActiveWorkbook.Sheets
                For Each col In ws.UsedRange.Columns
                        ws.Range(col.Address).RemoveDuplicates Columns:=1, Header:=xlNo
                Next col
        Next ws

End Sub

I did notice that this would throw a run-time error if you have an empty worksheet in your workbook, so I added some logic to test for an empty worksheet. The test consists of checking used rows, used columns, and the value of cell A1 on the sheet. If the row and column count are both 1 and nothing is in cell A1, I consider the sheet empty and the code will skip it. This is totally optional if you're sure that your workbook won't have an empty sheet. I just included it for completeness.

Sub RemoveDups()
        Dim ws As Worksheet
        Dim col As Range
        Dim IsSheetEmpty As Boolean

        IsSheetEmpty = False

        For Each ws In ActiveWorkbook.Sheets
                IsSheetEmpty = ws.UsedRange.Rows.Count = 1 _
                        And ws.UsedRange.Columns.Count = 1 _
                        And ws.Cells(1, 1).Value = ""
                If IsSheetEmpty = False Then
                        For Each col In ws.UsedRange.Columns
                                ws.Range(col.Address).RemoveDuplicates Columns:=1, Header:=xlNo
                        Next col
                End If
        Next ws

End Sub

The .RemoveDuplicates method was added in Office 2007, if you're using an earlier version that will require a different approach.