Create list of unique items from a column into another column
This is similar to Column2AnString_Unique except this one is faster, generates the list into another column, and uses "Remove Duplicates" feature in Excel.
Function CreateUniqueList(From_ColumnName, Optional From_RowNum = 1, Optional From_SheetName = "Active", Optional From_WB = "This", _
Optional To_ColumnName = "SameAsFrom", Optional To_SheetName = "Active", Optional To_WB = "This")
' Create list of unique items from a column into another column
' uses "Remove Duplicates" feature in Excel
' Caller can define "FROM" column sheet and workbook, "TO" column, sheet and workbook
' This is supposed to be faster since it is using "Remove Duplicates" feature in Excel
'
' Returns number of unique items exported to "TO" column (count includes header row)
' Still needs to be tested
'
' Assumes list always have header row
Rett = 0
If From_SheetName = "Active" Then From_SheetName = ActiveSheet.Name
If From_WB = "This" Then From_WB = ThisWorkbook.Name
If From_WB = "Active" Then From_WB = ActiveWorkbook.Name
If To_SheetName = "Active" Then To_SheetName = ActiveSheet.Name
If To_WB = "This" Then To_WB = ThisWorkbook.Name
If To_WB = "Active" Then To_WB = ActiveWorkbook.Name
If To_ColumnName = "SameAsFrom" Then To_ColumnName = From_ColumnName
If To_ColumnName = From_ColumnName And To_SheetName = From_SheetName And To_WB = From_WB Then
Else
' clearing "TO" column if it is not the same as "FROM"
Workbooks(To_WB).Worksheets(To_SheetName).Range(To_ColumnName & 1).EntireColumn.ClearContents
End If
Rows2Move = Workbooks(From_WB).Worksheets(From_SheetName).Range(From_ColumnName & From_RowNum).CurrentRegion.Rows.Count
Workbooks(To_WB).Worksheets(To_SheetName).Range(To_ColumnName & 1, To_ColumnName & Rows2Move + 1).Value = _
Workbooks(From_WB).Worksheets(From_SheetName).Range(From_ColumnName & From_RowNum, From_ColumnName & Rows2Move + From_RowNum).Value
' ActiveSheet.Range("$AA$1:$AE$12").RemoveDuplicates Columns:=2, Header:=xlYes
Workbooks(To_WB).Worksheets(To_SheetName).Range(To_ColumnName & 1, To_ColumnName & Rows2Move + 1).RemoveDuplicates 1, xlYes
DoEvents
Rett = Workbooks(To_WB).Worksheets(To_SheetName).Range(To_ColumnName & 1).CurrentRegion.Rows.Count
CreateUniqueList = Rett
End Function
Optional To_ColumnName = "SameAsFrom", Optional To_SheetName = "Active", Optional To_WB = "This")
' Create list of unique items from a column into another column
' uses "Remove Duplicates" feature in Excel
' Caller can define "FROM" column sheet and workbook, "TO" column, sheet and workbook
' This is supposed to be faster since it is using "Remove Duplicates" feature in Excel
'
' Returns number of unique items exported to "TO" column (count includes header row)
' Still needs to be tested
'
' Assumes list always have header row
Rett = 0
If From_SheetName = "Active" Then From_SheetName = ActiveSheet.Name
If From_WB = "This" Then From_WB = ThisWorkbook.Name
If From_WB = "Active" Then From_WB = ActiveWorkbook.Name
If To_SheetName = "Active" Then To_SheetName = ActiveSheet.Name
If To_WB = "This" Then To_WB = ThisWorkbook.Name
If To_WB = "Active" Then To_WB = ActiveWorkbook.Name
If To_ColumnName = "SameAsFrom" Then To_ColumnName = From_ColumnName
If To_ColumnName = From_ColumnName And To_SheetName = From_SheetName And To_WB = From_WB Then
Else
' clearing "TO" column if it is not the same as "FROM"
Workbooks(To_WB).Worksheets(To_SheetName).Range(To_ColumnName & 1).EntireColumn.ClearContents
End If
Rows2Move = Workbooks(From_WB).Worksheets(From_SheetName).Range(From_ColumnName & From_RowNum).CurrentRegion.Rows.Count
Workbooks(To_WB).Worksheets(To_SheetName).Range(To_ColumnName & 1, To_ColumnName & Rows2Move + 1).Value = _
Workbooks(From_WB).Worksheets(From_SheetName).Range(From_ColumnName & From_RowNum, From_ColumnName & Rows2Move + From_RowNum).Value
' ActiveSheet.Range("$AA$1:$AE$12").RemoveDuplicates Columns:=2, Header:=xlYes
Workbooks(To_WB).Worksheets(To_SheetName).Range(To_ColumnName & 1, To_ColumnName & Rows2Move + 1).RemoveDuplicates 1, xlYes
DoEvents
Rett = Workbooks(To_WB).Worksheets(To_SheetName).Range(To_ColumnName & 1).CurrentRegion.Rows.Count
CreateUniqueList = Rett
End Function
From_ColumnName, Optional From_RowNum = 1, Optional From_SheetName = "Active", Optional From_WB = "This", _
Optional To_ColumnName = "SameAsFrom", Optional To_SheetName = "Active", Optional To_WB = "This"
Optional To_ColumnName = "SameAsFrom", Optional To_SheetName = "Active", Optional To_WB = "This"
Views 192
Downloads 42
CodeID
DB ID
ANmarAmdeen
614
Revisions
v1.0
Tuesday
April
26
2022