Unique list from a matrix to a single column - vba

Question

I needed to collect a unique list of text from a matrix, ("J19:BU500" in my case which contains duplicates) and paste it in a column (column DZ in my case) in the same sheet.
I need to loop this for multiple sheets in the same workbook. I'm new to VBA and got this code from internet and customized a bit to my requirement. But I have two problems with the code:
When the matrix is empty in say sheet 5, the code runs fine upto sheet 4 and throws a runtime error at sheet5 and stops without looping further to next sheets.
Also, I actually wanted the unique list to start at Cell "DZ10". If I do that, the number of unique list reduces by 10. For say there are 25 uniques, only 15 gets pasted starting from cell "DZ10" whereas all 25 gets pasted from cell "DZ1".
Code:
Public Function CollectUniques(rng As Range) As Collection
Dim varArray As Variant, var As Variant
Dim col As Collection
If rng Is Nothing Or WorksheetFunction.CountA(rng) = 0 Then
Set CollectUniques = col
Exit Function
End If
If rng.Count = 1 Then
Set col = New Collection
col.Add Item:=CStr(rng.Value), Key:=CStr(rng.Value)
Else
varArray = rng.Value
Set col = New Collection
On Error Resume Next
For Each var In varArray
If CStr(var) <> vbNullString Then
col.Add Item:=CStr(var), Key:=CStr(var)
End If
Next var
On Error GoTo 0
End If
Set CollectUniques = col
End Function
Public Sub WriteUniquesToNewSheet()
Dim wksUniques As Worksheet
Dim rngUniques As Range, rngTarget As Range
Dim strPrompt As String
Dim varUniques As Variant
Dim lngIdx As Long
Dim colUniques As Collection
Dim WS_Count As Integer
Dim I As Integer
Set colUniques = New Collection
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 3 To WS_Count
Sheets(I).Activate
Set rngTarget = Range("J19:BU500")
On Error GoTo 0
If rngTarget Is Nothing Then Exit Sub '<~ in case the user clicks Cancel
Set colUniques = CollectUniques(rngTarget)
ReDim varUniques(colUniques.Count, 1)
For lngIdx = 1 To colUniques.Count
varUniques(lngIdx - 1, 0) = CStr(colUniques(lngIdx))
Next lngIdx
Set rngUniques = Range("DZ1:DZ" & colUniques.Count)
rngUniques = varUniques
Next I
MsgBox "Finished!"
End Sub
Any help is highly appreciated. Thankyou

Answer 1

You need to select the correct amount of cells to fill in all data from an array. Like Range("DZ10").Resize(RowSize:=colUniques.Count)
That error probably means that colUniques is nothing and therefore has no .Count. So test if it is Nothing before you use it.
You will end up with something like below:
Public Sub WriteUniquesToNewSheet()
Dim wksUniques As Worksheet
Dim rngUniques As Range, rngTarget As Range
Dim strPrompt As String
Dim varUniques As Variant
Dim lngIdx As Long
Dim colUniques As Collection
Dim WS_Count As Integer
Dim I As Integer
Set colUniques = New Collection
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 3 To WS_Count
Sheets(I).Activate
Set rngTarget = Range("J19:BU500")
'On Error GoTo 0 'this is pretty useless without On Error Resume Next
If rngTarget Is Nothing Then Exit Sub 'this is never nothing if you hardcode the range 2 lines above (therefore this test is useless)
Set colUniques = CollectUniques(rngTarget)
If Not colUniques Is Nothing Then
ReDim varUniques(colUniques.Count, 1)
For lngIdx = 1 To colUniques.Count
varUniques(lngIdx - 1, 0) = CStr(colUniques(lngIdx))
Next lngIdx
Set rngUniques = Range("DZ10").Resize(RowSize:=colUniques.Count)
rngUniques = varUniques
End If
Next I
MsgBox "Finished!"
End Sub