Excel 2013>VBA>Array>Fill with loop

[aworthey]

Hello,

I'm trying to fill my array with a loop. It's working well except for one aspect...I'm filling my array with a lot of empty strings in addition to the values I'm seeking. Any suggestions?

Here's my code:


Dim i As Integer
Dim xRow As Long
Dim rRange As Range
Dim strRSLT() As Variant
Dim strCODE As String
Dim intROW As Integer

With ThisWorkbook.Sheets("Naming Convention")
xRow = .Cells(.Rows.count, "A").End(xlUp).Row
End With
For i = 1 To xRow
ReDim Preserve strRSLT(i)
With ThisWorkbook.Sheets("Naming Convention")
If .Cells(i, 1).Value = strLKUP And .Cells(i, 1).Value > 0 Then
strRSLT(i) = .Cells(i, 8).Value
End If
End With
Next i
UserForm2.ComboBox3.List = strRSLT

[Kenneth Hobs]

Before filling, you can check for .Value<>"".

When I fill a list array, I like to remove duplicates, blanks, and sort. e.g.
Userform:

'http://www.mrexcel.com/forum/excel-questions/954117-populate-listbox-based-unique-combobox-selection.html

Private Sub UserForm_Initialize()
RangeUniqueSortFillControl Range("K2", Range("K" & Rows.Count).End(xlUp)), ComboBox1
End Sub


Module:

' http://www.mrexcel.com/forum/excel-questions/947408-combobox-list-becomes-unsorted.html


' Sort ascending, remove duplicates, remove blanks, fill control's list.
Sub RangeUniqueSortFillControl(aRange As Range, aControl As MSForms.Control)
Dim a() As Variant, b As Variant
a() = RangeTo1dArray(aRange)
b = UniqueArrayByDict(a(), tfStripBlanks:=True)
a() = ArrayListSort(b, True)
aControl.List = a()
End Sub


' http://www.excelforum.com/excel-programming-vba-macros/819998-filter-and-sort-scripting-dictionary.html
' Early Binding method requires Reference: MicroSoft Scripting Runtime, scrrun.dll
Function UniqueArrayByDict(Array1d() As Variant, Optional compareMethod As Integer = 0, _
Optional tfStripBlanks = False) As Variant
'Dim dic As Object 'Late Binding method - Requires no Reference
'Set dic = CreateObject("Scripting.Dictionary") 'Late or Early Binding method
Dim dic As Dictionary 'Early Binding method
Set dic = New Dictionary 'Early Binding Method
Dim e As Variant
dic.CompareMode = compareMethod
'BinaryCompare=0
'TextCompare=1
'DatabaseCompare=2
For Each e In Array1d
If Not dic.Exists(e) Then
If tfStripBlanks And e <> "" Then dic.Add e, Nothing
End If
Next e
UniqueArrayByDict = dic.Keys
End Function


Function RangeTo1dArray(aRange As Range) As Variant
Dim a() As Variant, c As Range, i As Long
ReDim a(0 To aRange.Cells.Count - 1)
i = i - 1
For Each c In aRange
i = i + 1
a(i) = c
Next c
RangeTo1dArray = a()
End Function


'http://www.vbaexpress.com/forum/showthread.php?48491
Function ArrayListSort(sn As Variant, Optional bAscending As Boolean = True)
With CreateObject("System.Collections.ArrayList")
Dim cl As Variant
For Each cl In sn
.Add cl
Next

.Sort 'Sort ascendending
If bAscending = False Then .Reverse 'Sort and then Reverse to sort descending
ArrayListSort = .Toarray()
End With
End Function

[p45cal]

Tweaking your macro:
With ThisWorkbook.Sheets("Naming Convention")
xRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
j = -1
For i = 1 To xRow
With ThisWorkbook.Sheets("Naming Convention")
If .Cells(i, 1).Value = strLKUP And .Cells(i, 1).Value > 0 Then
j = j + 1
ReDim Preserve strRSLT(j)
strRSLT(j) = .Cells(i, 8).Value
End If
End With
Next i
UserForm2.ComboBox3.List = strRSLT

[aworthey]

Thank you so very much, p45cal! This worked perfectly!

I appreciate everyone's suggestions!