filmov
tv
Excel Power Tip - Use VBA Collections to Remove Duplicates (Code Included)
Показать описание
Hi Excel Users,
In this video I will give you an overview of collections in Excel VBA and show you step-by-step how a small Excel dataset containing duplicates is output into a Unique dataset using VBA Collections.
Code is included as per below with code notes to help your understanding.
Enjoy!
-----------------------------------------------------------------------------------------------------------------------
Sub Collections_remove_duplicates()
'Excel VBA Collections is a way for you to store many similar related or
'unrelated 'values in a single variable rather than store values in separate variables
'Declare Variables
Dim Cars As Collection ' Collections object relates to cars
Dim sht As Worksheet ' sht is the worksheet containing the original items
Dim lngLastRow As Long ' used to get the Last used row of the Dataset
Dim lngRow As Long ' used as a cell row looping variable
Dim intIndex As Integer ' used as a Collections index looping variable
'Once the collection object variable is defined it needs to be instantiated
'(created) as a "New" collection like this:
Set Cars = New Collection
'Set worksheet object
Set sht = Worksheets("Duplicates") '' change here for your sheet name
sht.Range("A1").Select
'Find out true last row of Column A by working backwards from max rows
lngLastRow = sht.Cells(Application.Rows.Count, "A").End(xlUp).Row
'Now Add worksheet cells values in column A as Items to the Cars collection.
'If item is a duplicate key skip Add action by using On Error Resume Next
On Error Resume Next
For lngRow = 2 To lngLastRow
Cars.Add Item:=sht.Range("A" & lngRow).Value, Key:=CStr(sht.Range("A" & lngRow).Value)
'Confirm value has been checked to add to collection in Column B
sht.Range("B" & lngRow).Value = "Value Checked"
Next lngRow
'Now show contents of the Cars Collection of unique values in Column C
'by looping through the contents of the Cars Collection Object
For intIndex = 1 To Cars.Count() '' Could also do For each Item In Cars
sht.Range("C" & intIndex + 1).Value = Cars(intIndex) '' when pasting the collection member add 1 to start from row 2
Next
'Show message
MsgBox "All unique items pasted"
End Sub
In this video I will give you an overview of collections in Excel VBA and show you step-by-step how a small Excel dataset containing duplicates is output into a Unique dataset using VBA Collections.
Code is included as per below with code notes to help your understanding.
Enjoy!
-----------------------------------------------------------------------------------------------------------------------
Sub Collections_remove_duplicates()
'Excel VBA Collections is a way for you to store many similar related or
'unrelated 'values in a single variable rather than store values in separate variables
'Declare Variables
Dim Cars As Collection ' Collections object relates to cars
Dim sht As Worksheet ' sht is the worksheet containing the original items
Dim lngLastRow As Long ' used to get the Last used row of the Dataset
Dim lngRow As Long ' used as a cell row looping variable
Dim intIndex As Integer ' used as a Collections index looping variable
'Once the collection object variable is defined it needs to be instantiated
'(created) as a "New" collection like this:
Set Cars = New Collection
'Set worksheet object
Set sht = Worksheets("Duplicates") '' change here for your sheet name
sht.Range("A1").Select
'Find out true last row of Column A by working backwards from max rows
lngLastRow = sht.Cells(Application.Rows.Count, "A").End(xlUp).Row
'Now Add worksheet cells values in column A as Items to the Cars collection.
'If item is a duplicate key skip Add action by using On Error Resume Next
On Error Resume Next
For lngRow = 2 To lngLastRow
Cars.Add Item:=sht.Range("A" & lngRow).Value, Key:=CStr(sht.Range("A" & lngRow).Value)
'Confirm value has been checked to add to collection in Column B
sht.Range("B" & lngRow).Value = "Value Checked"
Next lngRow
'Now show contents of the Cars Collection of unique values in Column C
'by looping through the contents of the Cars Collection Object
For intIndex = 1 To Cars.Count() '' Could also do For each Item In Cars
sht.Range("C" & intIndex + 1).Value = Cars(intIndex) '' when pasting the collection member add 1 to start from row 2
Next
'Show message
MsgBox "All unique items pasted"
End Sub