View Full Version : [SOLVED:] Excel 2013>VBA>Array>Fill with loop
aworthey
08-04-2016, 01:02 PM
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
08-04-2016, 02:02 PM
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
08-04-2016, 05:46 PM
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
08-05-2016, 06:13 AM
Thank you so very much, p45cal! This worked perfectly!
I appreciate everyone's suggestions!
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.