Related
I need to display two columns A and B listed in a combobox with unique values. So if two rows have the same A but not the same B, it is not a duplicate, both column need to be duplicate. I found a code that list one column (A) with unique values but I don't know how to add the column B.
There's a picture of my data and how I want to display it in my ComboBox.
Here's the code:
Private Sub UserForm_Initialize()
Dim Cell As Range
Dim col As Variant
Dim Descending As Boolean
Dim Entries As Collection
Dim Items As Variant
Dim index As Long
Dim j As Long
Dim RngBeg As Range
Dim RngEnd As Range
Dim row As Long
Dim Sorted As Boolean
Dim temp As Variant
Dim test As Variant
Dim Wks As Worksheet
Set Wks = ThisWorkbook.Worksheets("Sheet1")
Set RngBeg = Wks.Range("A3")
col = RngBeg.Column
Set RngEnd = Wks.Cells(Rows.Count, col).End(xlUp)
Set Entries = New Collection
ReDim Items(0)
For row = RngBeg.row To RngEnd.row
Set Cell = Wks.Cells(row, col)
On Error Resume Next
test = Entries(Cell.Text)
If Err = 5 Then
Entries.Add index, Cell.Text
Items(index) = Cell.Text
index = index + 1
ReDim Preserve Items(index)
End If
On Error GoTo 0
Next row
index = index - 1
Descending = False
ReDim Preserve Items(index)
Do
Sorted = True
For j = 0 To index - 1
If Descending Xor StrComp(Items(j), Items(j + 1), vbTextCompare) = 1 Then
temp = Items(j + 1)
Items(j + 1) = Items(j)
Items(j) = temp
Sorted = False
End If
Next j
index = index - 1
Loop Until Sorted Or index < 1
ComboBox1.List = Items
End Sub
Any clue? Thanks!
Try this code, please. It assumes that unique definition means pairs of values from the two columns, on the same row, to be unique:
Sub UnicTwoValInTwoColumns()
Dim sh As Worksheet, arr As Variant, arrFin As Variant, countD As Long
Dim lastRow As Long, i As Long, j As Long, k As Long, boolDupl As Boolean
Set sh = ActiveSheet 'use here your sheet
'supposing that last row in column A:A is the same in column B:B
'If not, the last row for B:B will be calculated and then the higher will be chosen:
lastRow = sh.Range("A" & Rows.Count).End(xlUp).Row
ReDim arrFin(1 To 2, 1 To lastRow) 'redim the final array for maximum possible number of elements
arr = sh.Range("A3:B" & lastRow).value 'pun in array the range to be analized
k = 1 'initialize the first array element number
For i = 1 To UBound(arr, 1) 'iterate between the array elements
boolDupl = False 'initialize the variable proving that the pair of data already in arrFin
For j = 1 To k 'iterate between the arrFin elements in order to check for duplicates
If arr(i, 1) & arr(i, 2) = arrFin(1, j) & arrFin(2, j) Then
boolDupl = True: Exit For 'if a duplicate is found the loop is exited
End If
Next j
If Not boolDupl Then 'load the arrFin only if a duplicate has not been found
arrFin(1, k) = arr(i, 1): arrFin(2, k) = arr(i, 2)
k = k + 1 'increment the (real) array number of elements
End If
Next
ReDim Preserve arrFin(1 To 2, 1 To k - 1) 'redim array at the real dimension (preserving values)
With Me.ComboBox1
.ColumnCount = 2 'be sure that combo has 2 columns to receive values
.List = WorksheetFunction.Transpose(arrFin) 'fill the combo with the array elements
End With
End Sub
You can paste the code in the form Initialize event, or let the Sub like it is, copy it in the form module and only call it from the event in discussion. I would suggest you to proceed in this las way. If you have (or will have) something else in the event, it would be simpler to identify a problem if it occurs, I think,
I have a range in column D and a range in column F. These ranges contain strings, the strings in column D are unique (i.e. they do not repeat) and the strings in column F are also unique. However, column D and F should both contain the same strings most of the time, although they may be in a different order. The strings look something similar to:
tag:(0004)X-axis
tag:(0005)Z-axis
tag:(0005)X-axis
tag:(0006)Z-axis
Sometimes column D may be missing some of the strings or it may have some new strings. I want to compare column D to column F and if there are new strings in column D, I want to add (append) them to the end of column F. Here is a simple Example using simply a,b,c instead of "tag:(00... bla... bla...":
Column D Column F
a b
b c
c d
e e
f g
g
Column D is missing "d" but has "a" and "f"... so "a" and "f" will be added (apended) to the end to column F, like this:
Column F
b
c
d
e
g
a
f
I was trying to use this as a less direct route but I can't even get this to work:
Sub RT_COMPILER()
Dim Lastrow As Long
Dim r As Long
Dim n As Long
For r = 1 To Lastrow
n = Application.WorksheetFunction.CountIf(Range("D:D"), Cells(r, 6))
If n = 0 Then
Cells(r, 7) = Cells(r, 4)
Else
Cells(r, 7) = ""
End If
Next
End Sub
My thinking was: If I could get the new strings into column G... then delete the blank spaces then copy and paste them appending them to the end of column F... but it seems to just identify that the last item in column D is "g" and the last item in column F is blank and it would pull a "g" out of the list even though it already had a "g"...
When I originally found this code it had:
n = Application.WorksheetFunction.CountIf("D:D", Cells(r, 6))
it didn't work so I changed it to:
n = Application.WorksheetFunction.CountIf(Range("D:D"), Cells(r, 6))
This could be a bit overkill for Excel development, but in the long run, it is a good idea to work with Dictionary data type, as it is optimized to store unique values. Thus, once you find a way to pass the cells data to a dictionary, this is a way to add the missing values of setA to setB:
Sub TestMe()
Dim setA As Object
Dim setB As Object
Set setA = CreateObject("Scripting.Dictionary")
Set setB = CreateObject("Scripting.Dictionary")
AddToDictionaryIfNotPresent "A", setA
AddToDictionaryIfNotPresent "B", setA
AddToDictionaryIfNotPresent "C", setA
AddToDictionaryIfNotPresent "D", setA
AddToDictionaryIfNotPresent "A", setB
AddToDictionaryIfNotPresent "B", setB
AddToDictionaryIfNotPresent "A", setB 'C is missing!
AddToDictionaryIfNotPresent "D", setB
Dim var As Variant
For Each var In setA
If Not ValueExistsInCollection(var, setB) Then
Debug.Print "Adding "; var
AddToDictionaryIfNotPresent var, setB
End If
Next
End Sub
And these are the additional functions:
Public Function AddToDictionaryIfNotPresent(myValue As Variant, myDictionary As Object)
If Not myDictionary.Exists(myValue) Then myDictionary.Add myValue, 1
End Function
Public Function ValueExistsInCollection(myValue As Variant, myDictionary As Object) As Boolean
Dim var As Variant
For Each var In myDictionary
If var = myValue Then
ValueExistsInCollection = True
Exit Function
End If
Next var
End Function
At the end, all the unique values are at setB:
I think your CountIf was looking in the wrong column.
I recommend the following approach:
Option Explicit
Public Sub CompareAndAppend()
Dim ws As Worksheet 'define worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
Dim NextFreeRow As Long
NextFreeRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row + 1
Dim cnt As Long
Dim iRow As Long
For iRow = 1 To LastRow 'loop through column D
cnt = Application.WorksheetFunction.CountIf(ws.Range("F:F"), ws.Cells(iRow, "D"))
If cnt = 0 Then 'this value is missing in F, append it
ws.Cells(NextFreeRow, "F").Value = ws.Cells(iRow, "D")
NextFreeRow = NextFreeRow + 1 'move to next free row
End If
Next iRow
End Sub
The red ones were added.
A probably faster version would be using arrays and a dictionary:
Public Sub CompareAndAppendSpeedyGonzales()
Dim ws As Worksheet 'define worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim InputArr() As Variant
InputArr = ws.Range("D1", ws.Cells(ws.Rows.Count, "D").End(xlUp)).Value
Dim CompareArr() As Variant
CompareArr = ws.Range("F1", ws.Cells(ws.Rows.Count, "F").End(xlUp)).Value
Dim AppendArr As Variant
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim i As Long
'add column F
For i = LBound(CompareArr, 1) To UBound(CompareArr, 1)
If Not dict.exists(CompareArr(i, 1)) Then
dict.Add CompareArr(i, 1), 0
End If
Next i
'add column D
For i = LBound(InputArr, 1) To UBound(InputArr, 1)
If Not dict.exists(InputArr(i, 1)) Then
dict.Add InputArr(i, 1), 0
If IsEmpty(AppendArr) Then
ReDim AppendArr(1 To 1)
AppendArr(1) = InputArr(i, 1)
Else
ReDim Preserve AppendArr(1 To UBound(AppendArr) + 1)
AppendArr(UBound(AppendArr)) = InputArr(i, 1)
End If
End If
Next i
ws.Cells(ws.Rows.Count, "F").End(xlUp).Offset(1, 0).Resize(RowSize:=UBound(AppendArr)).Value = Application.WorksheetFunction.Transpose(AppendArr)
End Sub
Option Explicit
Sub test()
Dim LastrowD As Long, i As Long, LastrowF As Long, Times As Long
Dim cell As Range, rngToSearch As Range
Dim str As String
With ThisWorkbook.Worksheets("Sheet5")
LastrowD = .Cells(.Rows.Count, "D").End(xlUp).Row
For i = 1 To LastrowD
str = .Range("D" & i).Value
LastrowF = .Cells(.Rows.Count, "F").End(xlUp).Row
Set rngToSearch = .Range("F1:F" & LastrowF)
Times = Application.WorksheetFunction.CountIf(rngToSearch, str)
If Times = 0 Then
.Range("F" & LastrowF + 1) = str
End If
Next i
End With
End Sub
I have column A that has all existing categories, new categories are listed in column C. I'm trying to determine how to take these new categories, and add them to column "a" if they aren't already in column A. In the example the new categories in column C are added to column A even if there are already in column A. I would also need range("a1") in the if-then line to be a dynamic range since new categories will be added as the code runs. Some constructive criticism would be greatly appreciated as well to help me in the future.
Sub newcategory()
Dim newcatcount As Integer
Dim i As Integer
newcat = Range("c100000").End(xlUp).Row
For i = 1 To newcat
If Cells(i, 3).Value <> Range("a1") Then
Cells(i, 3).Select
Selection.copy
Range("a100000").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next
End Sub
Please give this a try...
Sub AddNewCategories()
Dim lrA As Long, lrC As Long, i As Long, j As Long
Dim x, y, z(), dict
lrA = Cells(Rows.Count, 1).End(xlUp).Row
lrC = Cells(Rows.Count, 3).End(xlUp).Row
'Array to hold the categories in column A starting from Row1, assuming the categories start from A1. If not, change it accordingly.
x = Range("A1:A" & lrA).Value
'Array to hold the new categories in column C starting from Row1, assuming the categories start from C1. If not, change it accordingly.
y = Range("C1:C" & lrC).Value
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(x, 1)
dict.Item(x(i, 1)) = ""
Next i
For i = 1 To UBound(y, 1)
If Not dict.exists(y(i, 1)) Then
dict.Item(y(i, 1)) = ""
j = j + 1
ReDim Preserve z(1 To j)
z(j) = y(i, 1)
End If
Next i
If j > 0 Then
Range("A" & lrA + 1).Resize(j).Value = Application.Transpose(z)
End If
Set dict = Nothing
End Sub
you could use excel built in RemoveDuplicates() function, as follows (mind the comments):
Option Explicit
Sub newcategory()
Dim newcat As Range
With Worksheets("Categories") ' change "Categories" to your actual sheeet name
Set newcat = .Range("C1", .Cells(.Rows.Count, 3).End(xlUp)) ' get the range of all nwe categories in reference sheet column C from row 1 down to last not empty one
.Cells(.Rows.Count, 1).End(xlUp).Resize(newcat.Rows.Count).Value = newcat.Value ' append new categories values below existing categories in column A
.Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).RemoveDuplicates Columns:=Array(1), Header:=xlNo ' remove duplicates
End With
End Sub
I am trying to make edge relation from excel file which are organized in rows,
A,B,C,
D,E
the aim is to create relationships from each row:
A,B
A,C
B,C
I have the following codes , the problem is the codes is efficient when rows are equal in length but for example for above rows it create also following edges (relationship):
D," "
E, " "
Which create big problem for large data set. I was wondering if some body can help me to adjust the code the way to create the edge list only till filled cells in each row. If there is any other way to do this more efficient will appreciate it.
Thank you so much,Will be great help.
My code:
Sub Transform()
Dim targetRowNumber As Long
targetRowNumber = Selection.Rows(Selection.Rows.Count).Row + 2
Dim col1 As Variant
Dim cell As Range
Dim colCounter As Long
Dim colCounter2 As Long
Dim sourceRow As Range: For Each sourceRow In Selection.Rows
For colCounter = 1 To Selection.Columns.Count - 1
col1 = sourceRow.Cells(colCounter).Value
For colCounter2 = colCounter + 1 To Selection.Columns.Count
Set cell = sourceRow.Cells(, colCounter2)
If Not cell.Column = Selection.Column Then
Selection.Worksheet.Cells(targetRowNumber, 1) = col1
Selection.Worksheet.Cells(targetRowNumber, 2) = cell.Value
targetRowNumber = targetRowNumber + 1
End If
Next colCounter2
Next colCounter
Next sourceRow
End Sub
I've played around with it - this should do the trick. We can probably speed it up by outputting to another variant array if needed, but this ran pretty quickly for me:
Sub Transform_New()
Dim rngSource As Range, rngDest As Range
Dim varArray As Variant
Dim i As Integer, j As Integer, k As Integer
Set rngSource = Sheet1.Range("A1", Sheet1.Cells(WorksheetFunction.CountA(Sheet1.Columns(1)), 1)) 'Put all used rows into range
Set rngDest = Sheet1.Cells(WorksheetFunction.CountA(Sheet1.Columns(1)), 1).Offset(2, 0) 'Set target range to start 2 below source range
varArray = Range(rngSource, rngSource.Offset(0, Range("A1").SpecialCells(xlCellTypeLastCell).Column)).Value
For i = LBound(varArray, 1) To UBound(varArray, 1) 'Loop vertically through array
For j = LBound(varArray, 2) To UBound(varArray, 2) 'Loop horizontally through each line apart from last cell
k = j
Do Until varArray(i, k) = ""
k = k + 1
If varArray(i, k) <> "" Then
rngDest.Value = varArray(i, j)
rngDest.Offset(0, 1).Value = varArray(i, k)
Set rngDest = rngDest.Offset(1, 0)
End If
Loop
Next
Next
End Sub
Assume I have a block of data in Excel 2010, 100 rows by 3 columns.
Column C contains some duplicates, say it starts off as
1, 1, 1, 2, 3, 4, 5, ..... , 97, 98
Using VBA, I would like to remove the duplicate rows so I am left with 98 rows and 3 columns.
1, 2, 3, ..... , 97, 98
I know there is a button in Excel 2010 to do that but it inteferes with the rest of my code subsequently and gives incorrect results.
Furthermore, I would like to do it in arrays, then paste the results on the worksheet, rather than methods such as Application.Worksheetfunction.countif(.....
So something like:
Dim myarray() as Variant
myarray=cells(1,1).Currentregion.value
Dim a as Long
For a=1 to Ubound(myarray,1)
'something here to
Next a
I answered a similar question. Here is the code I used:
Dim dict As Object
Dim rowCount As Long
Dim strVal As String
Set dict = CreateObject("Scripting.Dictionary")
rowCount = Sheet1.Range("A1").CurrentRegion.Rows.Count
'you can change the loop condition to iterate through the array rows instead
Do While rowCount > 1
strVal = Sheet1.Cells(rowCount, 1).Value2
If dict.exists(strVal) Then
Sheet1.Rows(rowCount).EntireRow.Delete
Else
'if doing this with an array, then add code in the Else block
' to assign values from this row to the array of unique values
dict.Add strVal, 0
End If
rowCount = rowCount - 1
Loop
Set dict = Nothing
If you want to use an array, then loop through the elements with the same conditional (if/else) statements. If the item doesn't exist in the dictionary, then you can add it to the dictionary and add the row values to another array.
Honestly, I think the most efficient way is to adapt code you'd get from the macro recorder. You can perform the above function in one line:
Sheet1.UsedRange.RemoveDuplicates Columns:=3, Header:=xlYes
Function eliminateDuplicate(poArr As Variant) As Variant
Dim poArrNoDup()
dupArrIndex = -1
For i = LBound(poArr) To UBound(poArr)
dupBool = False
For j = LBound(poArr) To i
If poArr(i) = poArr(j) And Not i = j Then
dupBool = True
End If
Next j
If dupBool = False Then
dupArrIndex = dupArrIndex + 1
ReDim Preserve poArrNoDup(dupArrIndex)
poArrNoDup(dupArrIndex) = poArr(i)
End If
Next i
eliminateDuplicate = poArrNoDup
End Function
Simple function to remove duplicates from a 1D array
Private Function DeDupeArray(vArray As Variant) As Variant
Dim oDict As Object, i As Long
Set oDict = CreateObject("Scripting.Dictionary")
For i = LBound(vArray) To UBound(vArray)
oDict(vArray(i)) = True
Next
DeDupeArray = oDict.keys()
End Function
Edit:
With stdVBA (a library largely maintained by myself) you can use:
uniqueValues = stdEnumerator.CreateFromArray(myArray).Unique().AsArray()
An improvement on #RBILLC and #radoslav006 answers, this version searches the array with the duplicates removed for existing values so it searchs less values to find a duplicate.
Public Function RemoveDuplicatesFromArray(sourceArray As Variant)
Dim duplicateFound As Boolean
Dim arrayIndex As Integer, i As Integer, j As Integer
Dim deduplicatedArray() As Variant
arrayIndex = -1
deduplicatedArray = Array(1)
For i = LBound(sourceArray) To UBound(sourceArray)
duplicateFound = False
For j = LBound(deduplicatedArray) To UBound(deduplicatedArray)
If sourceArray(i) = deduplicatedArray(j) Then
duplicateFound = True
Exit For
End If
Next j
If duplicateFound = False Then
arrayIndex = arrayIndex + 1
ReDim Preserve deduplicatedArray(arrayIndex)
deduplicatedArray(arrayIndex) = sourceArray(i)
End If
Next i
RemoveDuplicatesFromArray = deduplicatedArray
End Function
Here's another approach for working with an array:
Sub tester()
Dim arr, arrout
arr = Range("A1").CurrentRegion.Value 'collect the input array
arrout = UniqueRows(arr) 'get only unique rows
Range("H1").Resize(UBound(arrout, 1), UBound(arrout, 2)).Value = arrout
End Sub
Function UniqueRows(arrIn As Variant) As Variant
Dim keys, rw As Long, col As Long, k, sep, arrout
Dim dict As Object, lbr As Long, lbc As Long, ubr As Long, ubc As Long, rwOut As Long
Set dict = CreateObject("scripting.dictionary")
'input array bounds
lbr = LBound(arrIn, 1)
ubr = UBound(arrIn, 1)
lbc = LBound(arrIn, 2)
ubc = UBound(arrIn, 2)
ReDim keys(lbr To ubr)
'First pass:collect all the row "keys" in an array
' and unique keys in a dictionary
For rw = lbr To ubr
k = "": sep = ""
For col = lbc To ubc
k = k & sep & arrIn(rw, col)
sep = Chr(0)
Next col
keys(rw) = k 'collect key for this row
dict(k) = True 'just collecting unique keys
Next rw
'Resize output array to # of unique rows
ReDim arrout(lbr To dict.Count + (lbr - 1), lbc To ubc)
rwOut = lbr
'Second pass: copy each unique row to the output array
For rw = lbr To ubr
If dict(keys(rw)) Then 'not yet output?
For col = lbc To ubc 'copying this row over to output...
arrout(rwOut, col) = arrIn(rw, col)
Next col
rwOut = rwOut + 1 'increment output "row"
dict(keys(rw)) = False 'flag this key as copied
End If
Next rw
UniqueRows = arrout
End Function
Answer from #RBILLC could be easily improved by adding an Exit For inside internal loop:
Function eliminateDuplicate(poArr As Variant) As Variant
Dim poArrNoDup()
dupArrIndex = -1
For i = LBound(poArr) To UBound(poArr)
dupBool = False
For j = LBound(poArr) To i
If poArr(i) = poArr(j) And Not i = j Then
dupBool = True
Exit For
End If
Next j
If dupBool = False Then
dupArrIndex = dupArrIndex + 1
ReDim Preserve poArrNoDup(dupArrIndex)
poArrNoDup(dupArrIndex) = poArr(i)
End If
Next i
eliminateDuplicate = poArrNoDup
End Function
I think this is really a case for using excel's native functions, at least for the initial array acquisition, and I don't think there's any simpler way to do it. This sub will output the unique values starting in column 5. I assumed that the target range was empty, so if it's not, change r and c.
Sub testUniques()
Dim arr, r As Long, c As Long, h As Long, w As Long
Dim this As Worksheet: Set this = ActiveSheet
arr = Application.Unique(this.Cells(1, 1).CurrentRegion)
r = 1
c = 5
h = UBound(arr, 1) - 1
w = UBound(arr, 2) - 1
this.Range(this.Cells(r, c), this.Cells(r + h, c + w)) = arr
End Sub
I know this is old, but here's something I used to copy duplicate values to another range so that I could see them quickly to establish data integrity for a database I was standing up from various spreadsheets. To make the procedure delete the duplicates it would be as simple as replacing the dupRng lines with Cell.Delete Shift:=xlToLeft or something to that effect.
I haven't tested that personally, but it should work.
Sub PartCompare()
Dim partRng As Range, partArr() As Variant, i As Integer
Dim Cell As Range, lrow As Integer
lrow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
i = 0
Set partRng = ThisWorkbook.Worksheets("Sheet1").Range(Cells(1, 1), Cells(lrow, 1))
For Each Cell In partRng.Cells
ReDim Preserve partArr(i)
partArr(i) = Cell.Value
i = i + 1
Next
Dim dupRng As Range, j As Integer, x As Integer, c As Integer
Set dupRng = ThisWorkbook.Worksheets("Sheet1").Range("D1")
x = 0
c = 1
For Each Cell In partRng.Cells
For j = c To UBound(partArr)
If partArr(j) = Cell.Value Then
dupRng.Offset(x, 0).Value = Cell.Value
dupRng.Offset(x, 1).Value = Cell.Address()
x = x + 1
Exit For
End If
Next j
c = c + 1
Next Cell
End Sub
Remove duplicates (plus related row items) from array
As OP wanted a VBA solution close to RemoveDuplicates, I demonstrate an array approach using a â–ºdictionary to get not the unique items per se (dict.keys), but the related row indices of first occurrencies (dict.items).
These are used to retain the whole row data via procedure LeaveUniques profiting from the advanced possibilities of the â–ºApplication.Index() function - c.f. Some peculiarities of the the Application.Index function
Example Call
Sub ExampleCall()
'[0]define range and assign data to 1-based 2-dim datafield
With Sheet1 ' << reference to your project's sheet Code(Name)
Dim lastRow: lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Dim rng: Set rng = .Range("C2:E" & lastRow)
End With
Dim data: data = rng ' assign data to 2-dim datafield
'[1]get uniques (column 1) and remove duplicate rows
LeaveUniques data ' << call procedure LeaveUniques (c.f. RemoveDuplicates)
'[2]overwrite original range
rng.Clear
rng.Resize(UBound(data), UBound(data, 2)) = data
End Sub
Procedure LeaveUniques
Sub LeaveUniques(ByRef data As Variant, Optional ByVal colNum As Long = 1)
'Purpose: procedure removes duplicates of given column number in entire array
data = Application.Index(data, uniqueRowIndices(data, colNum), nColIndices(UBound(data, 2)))
End Sub
Help functions to LeaveUniques
Function uniqueRowIndices(data, Optional ByVal colNum As Long = 1)
'Purpose: return data index numbers referring to uniques
'a) set late bound dictionary to memory
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
'b) slice e.g. first data column (colNum = 1)
Dim colData
colData = Application.Index(data, 0, colNum)
'c) fill dictionary with uniques referring to first occurencies
Dim i As Long
For i = 1 To UBound(colData)
If Not dict.exists(dict(colData(i, 1))) Then dict(colData(i, 1)) = i
Next
'd) return 2-dim array of valid unique 1-based index numbers
uniqueRowIndices = Application.Transpose(dict.items)
End Function
Function nColIndices(ByVal n As Long)
'Purpose: return "flat" array of n column indices, e.g. for n = 3 ~> Array(1, 2, 3)
nColIndices = Application.Transpose(Evaluate("row(1:" & n & ")"))
End Function