Removing Duplicates dynamic columns VBA

[rconverse]

Hello,

I have a loop that I've set up to go through each worksheet in a workbook and perform a series of tasks. The last task is to remove duplicates. The issue is that each worksheet could have a different number of columns. Is there a way to dynamically create an array for Excel to remove duplicates?

In the first worksheet, there are 22 columns, so this works:

rng.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22)

However, the next spreadsheet only has 17 columns, so that won't work. I don't want to setup a case or if statement for each worksheet because a column may get added down the road and I don't want to have to touch the code going forward. I can get the last column with data, no problem. I just need to incorporate that in the above code as opposed to hard coded numbers.

Thanks in advance for any suggestions.

Roger

 

[rconverse]

Turns out you don't have to do anything. If you leave the column assignment out, it defaults to all columns.

http://vbadud.blogspot.com/2008/07/remove-duplicate-rows-from-sheet-using.html

Parameters Columns Optional Variant Array of indexes of the columns that contain the duplicate information. If nothing is passed then it assumes all columns contain duplicate information.

 

[rconverse]

That's not working. My code is below and runs, but doesn't actually remove duplicates.

Set rng = ws.Range(Cells(2, 1), Cells(LargestRow, LastCol))
    
'remove duplicates
rng.RemoveDuplicates

So I guess my question remains. Is there an alternative to code columns than this:

ActiveSheet.Range("$A$1:$Q$5").RemoveDuplicates Columns:=Array(1, 2, 3, 4, _
5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17), Header:=xlYes

Thanks,
Roger

 

[rconverse]

Latest failure.

'set the range to search duplicates
    ws.Activate
    Set rng = ws.Range(Cells(2, 1), Cells(LargestRow, LastCol))
        
        'find the number of columns and enter into the array
        ReDim varArray1(LastCol - 1)
        'ReDim varArray1(Application.WorksheetFunction.CountA(rng))
        index = 0
        'loop through range and load values to the array
        Do Until index > LastCol - 1
            varArray1(index) = index + 1
            index = index + 1
        Loop
    
    'remove duplicates
    rng.Select
    rng.RemoveDuplicates Columns:=varArray1(index), Header:=xlNo

I receive a subscript out of range error for varArray1.

It looks like the array is populated with numbers from 1-22, which is the number of columns, so I'd think this would work.

Any suggestions out there?

 

[rconverse]

Success!!!!

    'set the range to search duplicates
    ws.Activate
    Set rng = ws.Range(Cells(1, 1), Cells(LargestRow, LastCol))
        
        'find the number of columns and enter into the array
        ReDim varArray1(LastCol - 1)
        'ReDim varArray1(Application.WorksheetFunction.CountA(rng))
        index = 0
        'loop through range and load values to the array
        Do Until index > LastCol - 1
            varArray1(index) = index + 1
            
            If index + 1 = LastCol Then GoTo exitLoop
            
            index = index + 1
            
        Loop
        
exitLoop:
    
    'remove duplicates
    rng.Select
    rng.RemoveDuplicates Columns:=varArray1(index), Header:=xlNo

What was happening, was after I loaded the last number into the array, I still increased "index + 1". That was causing the subscript out of range error. Remove that and you're golden.

So there you have it. Removing duplicated based on columns with data. Woo-hoo!!

 

[rconverse]

^False alarm! I didn't do anything. The code runs, but it doesn't remove the duplicates properly. The only way I can get this to work is to create the array in the original post which means I have to create a select statement to determine which sheet it is and if columns are ever added, the code needs to be updated.

If anyone has a better solution, please help me out. I'm going crazy over here. I feel like I should be able to create my own dynamic array and use that.

Thanks,
Roger

 

[wangelin]

^False alarm! I didn't do anything. The code runs, but it doesn't remove the duplicates properly. The only way I can get this to work is to create the array in the original post which means I have to create a select statement to determine which sheet it is and if columns are ever added, the code needs to be updated.

If anyone has a better solution, please help me out. I'm going crazy over here. I feel like I should be able to create my own dynamic array and use that.

Thanks,
Roger

The RemoveDuplicates method looks like a dead end, I can't figure it out either.

Here is a solution, it ain't pretty but it gets the work done. It uses the AdvancedFilter-method.

Sub RemoveDuplicates(r As Range, tmp As Range)
  tmp.Resize(1, r.Columns.Count).Value = r.Rows(1).Value
  r.AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=tmp.Resize(1, r.Columns.Count), Unique:=True
  Set tmp = Range(tmp.Range("A1"), tmp.Range("A1").End(xlDown).End(xlToRight))
  r.ClearContents
  r.Resize(tmp.Rows.Count, tmp.Columns.Count).Value = tmp.Value
  tmp.ClearContents
End Sub
Sub test()
  Call RemoveDuplicates([A1:C7], [E1])
End Sub

The AdvancedFilter copies unique records from the r-range to the tmp-range, then r is cleared and replaced by tmp and finally tmp is cleared.

 

[DavidAckroyd]

I appreciate this is a bit after the horse has bolted but if anyone like me finds this post and wants an answer, the following code works fine for me, I think the secret is to force it to be a zero based array (e.g. redim ... (0 to ##).

In this code sDestTable is name of the Excel table I've just populated with more data, but could also be a standard range, for a range drop the "[#All]" which is table specific.

  ... 
  Range(sDestTable & "[#All]").Select
  lNumCols = Range(sDestTable & "[#All]").Columns.Count
  ActiveSheet.Range(sDestTable & "[#All]").RemoveDuplicates Columns:=BuildColArray(lNumCols), Header:=xlYes  
  ...
End Function

Function BuildColArray(lNum As Long) As Variant
  Dim vMyArray As Variant
  Dim idx As Integer
  
  ReDim vMyArray(0 To lNum - 1)
  
  For idx = 1 To lNum
    vMyArray(idx - 1) = idx
  Next idx
  
  BuildColArray = vMyArray
End Function

 

[excelVBAmaster]

I know this thread is getting older, but I got the original problem to work for those who find this thread through google searches ect.

Change:

rng.RemoveDuplicates Columns:=varArray1(index), Header:=xlNo

To:

rng.RemoveDuplicates Columns:=(varArray1), Header:=xlNo

You are only telling it to Remove duplicates on the last column if you leave it as varArray1(index)..

 

[ssully87]

I know this is crazy old but here is a simple way.

Range("A1").Select
ActiveSheet.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).RemoveDuplicates Columns:=1, Header:=xlYes