Creating dynamic multi (and variable) column remove duplicates in VBA

wcurran

New Member
Joined
Apr 1, 2013
Messages
3
Using Excel 2010 on a Windows 7 machine. Trying to create code to allow a user to hit a button and have the data remove duplicates for the data selected. For example, if the columns are WBS, Labor Category, and Name, the user can select any combination of those three to produce a listing of the associated data with no duplicates. In my case, I have 8 columns so the 'Remove duplicates' has to adjust dynamically to the columns selected by the user.

I'm close but I get a Run-time error 1004: Application-defined or object-defined error.

My code:
Sub VolTable_SelectAndSort()
Dim Calc_Range As Variant
Dim CLIN, WBS, Co, Ref, LCat, ResName, BU, FSS, StartRange, EndRange As Range
Dim CalcRng1, CalcRng2, CalcRng3, CalcRng4, CalcRng5, CalcRng6, CalcRng7, CalcRng8, ctr As Integer
Dim StartCtr, EndCtr, CalcEnd, ArraySlots As Integer

'
' Determines the data to use
'
ArraySlots = 0
StartCtr = 0
EndCtr = 0

Set CLIN = Range("B3")
If CLIN = "Include" Then
CalcRng1 = 1
Calc_Range = Array(CalcRng1)
End If
Set WBS = Range("C3")
If WBS = "Include" Then
CalcRng2 = 2
ArraySlots = ArraySlots + 1
End If
Set Co = Range("D3")
If Co = "Include" Then
CalcRng3 = 3
ArraySlots = ArraySlots + 1
End If
Set FSS = Range("I3")
If FSS = "Include" Then
CalcRng4 = 4
ArraySlots = ArraySlots + 1
End If
Set Ref = Range("E3")
If Ref = "Include" Then
CalcRng5 = 5
ArraySlots = ArraySlots + 1
End If
Set BU = Range("F3")
If BU = "Include" Then
CalcRng6 = 6
ArraySlots = ArraySlots + 1
End If
Set LCat = Range("G3")
If LCat = "Include" Then
CalcRng7 = 7
ArraySlots = ArraySlots + 1
End If
Set ResName = Range("H3")
If ResName = "Include" Then
CalcRng8 = 8
ArraySlots = ArraySlots + 1
End If

Calc_Range = Array(CalcRng1, CalcRng2, CalcRng3, CalcRng4, CalcRng5, CalcRng6, CalcRng7, CalcRng8)
Range("BA6:BH210").Select
selection.Copy
Range("BK6").Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

ActiveSheet.Range("BK6:BR210").RemoveDuplicates Columns:=(Calc_Range), Header:=xlNo
Range("F2").Select

End Sub



Thanks!!
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Is there a reason why using the "Remove Duplicates" button on the ribbon wouldn't work?
 
Upvote 0
The model is pretty well locked down and the people using it may not understand how the remove duplicates function works. Trying to automate it so that they can make their selections then hit a button to do the rest. Thanks!
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top