I've created 3 combobox as below which are to generate results from a listbox. I would like to generate an error box if any of the 3 comboboxes are left empty. However, the code I wrote generates multiple error msg boxes. How do I fix this so msgbox only appears once?
Private Sub Generateresults_Click()
Dim x As Integer
Dim i As Integer
Dim j As Integer
Dim p As Integer
p = Sheets("Training1A").UsedRange.Rows.Count
Sheets("Results").Range("A2:P" & p).ClearContents
x = 2
For i = 0 To Me.Listtest.ListCount - 1
If Me.Searchoption = "AND" Then
If Me.Listtest.Column(1, i) = Search1 And Me.Listtest.Column(2, i) = Search2 Then
For j = 0 To 9
Sheets("results").Cells(x, j + 1) = Me.Listtest.Column(j, i)
Next j
x = x + 1
Else
x = x
End If
ElseIf Me.Searchoption = "OR" Then
If Me.Listtest.Column(1, i) = Search1 Or Me.Listtest.Column(2, i) = Search2 Then
For j = 0 To 9
Sheets("results").Cells(x, j + 1) = Me.Listtest.Column(j, i)
Next j
x = x + 1
Else
x = x
End If
ElseIf Me.Searchoption = "ALL" Then
For j = 0 To 9
Sheets("results").Cells(x, j + 1) = Me.Listtest.Column(j, i)
Next j
x = x + 1
Else
x = x
**If Searchoption = "" Or Search1 = "" Or Search2 = "" Then
MsgBox "Select an option"
End If**
End If
Next i
End Sub
If you want to bail out after dispaying the first MsgBox, put Exit Sub under it.
If Searchoption = "" Or Search1 = "" Or Search2 = "" Then
MsgBox "Select an option"
Exit Sub
End If
Otherwise, the MsgBox call being inside the For...Next loop body, it will be repeated for every iteration that satisfies the conditions.
If you need to run more code between Next and End Sub regardless of whether the MsgBox was shown or not, then you can also Exit For, to exit the loop but remain inside the procedure:
If Searchoption = "" Or Search1 = "" Or Search2 = "" Then
MsgBox "Select an option"
Exit For
End If
Related
I'm trying to find the values in different points of the array. When I run the code, it always goes to The value doesn't exists, also I do not know how to count the values that are same r.
r = 0
c = txtbbus.Text
For i = 0 To n - 1
For j = 0 To n - 1
If a(i, j) = c Then
txtbres.Text = "The value exists " & r & " and it's in the position (" & i & ", " & j & ") "
Else
txtbres.Text = "The value doesn't exists"
End If
Next j
Next i
And this is how I initialize a:
txtbmatriz.Text = ""
For i = 0 To n - 1
For j = 0 To n - 1
a(i, j) = CInt((100 * Rnd()) + 1)
txtbmatriz.Text += a(i, j) & " "
m += a(i, j)
l += 1
Next j
txtbmatriz.Text += vbCrLf
Next i
The problem is almost certainly that you don't break out of the loop when you find a match. Your code will only ever show you the result of the last element in the array because you always keep searching to the last element. Once you find a match, there's no point to looking further and, in fact, doing so is detrimental. Once you find a match, stop looking.
Finding a single/first match:
Dim rng As New Random
Dim matrix = New Integer(9, 9) {}
For i = 0 To matrix.GetUpperBound(0)
For j = 0 To matrix.GetUpperBound(1)
matrix(i, j) = rng.Next(1, 101)
Next
Next
Dim target = rng.Next(1, 101)
Dim message As String
For i = 0 To matrix.GetUpperBound(0)
For j = 0 To matrix.GetUpperBound(1)
If matrix(i, j) = target Then
message = $"{target} found at ({i},{j})"
Exit For
End If
Next
If message IsNot Nothing Then
Exit For
End If
Next
Console.WriteLine(If(message, $"{target} not found"))
Finding all matches:
Dim rng As New Random
Dim matrix = New Integer(9, 9) {}
For i = 0 To matrix.GetUpperBound(0)
For j = 0 To matrix.GetUpperBound(1)
matrix(i, j) = rng.Next(1, 101)
Next
Next
Dim target = rng.Next(1, 101)
Dim matches As New List(Of String)
For i = 0 To matrix.GetUpperBound(0)
For j = 0 To matrix.GetUpperBound(1)
If matrix(i, j) = target Then
matches.Add($"({i},{j})")
End If
Next
Next
Console.WriteLine(If(matches.Any(),
$"{target} found at {String.Join(", ", matches)}",
$"{target} not found"))
Try this:
r = 0
c = txtbbus.Text
Dim i As Integer
Dim j As Integer
Dim FoundMatch As Boolean = False
For i = 0 To n - 1
For j = 0 To n - 1
If a(i, j) = c Then
FoundMatch = True
Exit For
End If
Next j
If FoundMatch = True Then
Exit For
End If
Next i
If FoundMatch = True Then
txtbres.Text = "The value exists " & r & " and it's in the position (" & i & ", " & j & ") "
Else
txtbres.Text = "The value doesn't exists"
End If
I'm going to assume c = txtbbus.Text is from some form input. Meaning a string. For the equality check you'd be testing against an Int type. Try casting the input from txtbbus.Text as an integer. Also, like the other poster said breaking from the loop on finding your match would also be a good decision.
I need to build a list of superscripts in a document which is fine until I get to symbols for things like partial derivatives which instead return as ? in my array instead of ∂. What could I add to capture the actual symbol? Thanks
Dim i As Long, j As String
Dim txtboxString() As String
Dim Superscript As String
Dim myrange As range
Dim ap As Document: Set ap = ActiveDocument
x = 0
For i = 1 To ap.Characters.Count
j = ""
If ActiveDocument.Characters(i).Font.Superscript = True Then
Z = 0
ReDim Preserve txtboxString(x + 1)
For Z = i To i - 5 Step -1
If Z > ap.Characters.Count Then GoTo 1
If ActiveDocument.Characters(Z) = "," Then GoTo 0
If ActiveDocument.Characters(Z).Font.Superscript = True Then j = ActiveDocument.Characters(Z) & j
Next Z
End If
0: If j <> "" Then
If j <> "," Then
If j <> "?" Then
txtboxString(x) = j
x = x + 1
End If
End If
End If
If Z + 1 > ap.Characters.Count Then i = Z 'Else i = Z + 1
Set myrange = ActiveDocument.Characters(i + 1)
myrange.MoveUntil Cset:="* "
i = myrange.End - 1
Next
This question is based on this puzzle that I am trying to do in vba: https://codegolf.stackexchange.com/questions/166765/fun-with-strings-and-numbers
Basically we have strings in col A and numbers in column B and in column C we have to generate a list so that:
The total count of any string should be exactly equal to its
corresponding number in the input data.
No string should be repeated adjacently in the sequence, and every
string should appear in the output list.
The selection of the next string should be done randomly as long as
they don't break above two rules. Each solution should have a
non-zero probability of being chosen.
If no combination is possible, the output should be just 0.
I tried this but I don't how to solve the problem so that it doesn't break rule #2. Any input would be appreciated thanks.
Sub generateList()
Application.ScreenUpdating = False
Dim fI As Long, totTimes As Long, i As Long, j As Long, fO As Long, tryCount As Long
Dim myArr()
Dim randNum As Long
OUT.Range("A1:A" & OUT.Rows.Count).Clear
fO = 1
With DATA
fI = .Range("A" & .Rows.Count).End(xlUp).Row
If fI < 2 Then MsgBox "No data!": Exit Sub
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("B2:B" & fI), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With DATA.Sort
.SetRange DATA.Range("A1:B" & fI)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
fI = .Range("A" & .Rows.Count).End(xlUp).Row
If fI < 2 Then MsgBox "No data!": Exit Sub
totTimes = 0: j = 0
For i = 2 To fI
If Trim(.Range("A" & i).Value) <> "" And IsNumeric(.Range("B" & i).Value) Then j = j + 1
Next i
If j < 1 Then MsgBox "No valid data present. Make sure column B has numbers and column A some string.": Exit Sub
ReDim Preserve myArr(1 To j, 1 To 2)
j = 0
For i = 2 To fI
If Trim(.Range("A" & i).Value) <> "" And IsNumeric(.Range("B" & i).Value) Then
totTimes = totTimes + CLng(.Range("B" & i).Value)
j = j + 1
myArr(j, 1) = .Range("A" & i)
myArr(j, 2) = .Range("B" & i)
End If
Next i
Do While totTimes > 0
randNum = WorksheetFunction.RandBetween(1, j)
If myArr(randNum, 2) > 0 Then
totTimes = totTimes - 1
OUT.Range("A" & fO) = myArr(randNum, 1)
myArr(randNum, 2) = myArr(randNum, 2) - 1
fO = fO + 1
End If
tryAgain:
Loop
End With
Application.ScreenUpdating = True
OUT.Activate
MsgBox "Process Completed"
End Sub
I have a solution (that isn't based on yours, unfortunately) that gives correct results... some of the time. I think I know why it falls short, I just have given up on fixing it.
It's also terrible for golfing, since it's a rather large amount of code, and it's an unholy mishmash of different approaches and implementation ideas that I made up as I went (and I never cleaned it up properly)... but maybe some of this will inspire you to get further.
As per rule #3, I select each letter at random. It was hit and miss using only that approach so I moved to weighted probabilities, which is what the code further down uses - and it seems to work somewhat well. Occasionally there will be 1 letter too many for one of the elements, or there will be adjacent equal elements, so it doesn't actually solve the puzzle all the time.
Ideas to remedy this problem:
Adjust the probability weights based on the frequency each letter has already been used. If you set dbg to true, you'll see that I implemented some calculations with that in mind, but never got around to figuring out how to actually adjust the weights themselves.
Hardcode a check or two for how many letters have been used early in the result, for the largest element group
Change the rand section to make more than 1 pass (maybe best out of 3) - the weights are sorted by "size", so doing 3 (or n) passes should increasingly favor the larger element groups
Maybe a combination of the first and the last suggestion.
Here's the code:
Sub NonRepeatSort(v() As String)
Dim lElementCount As Long
Dim lElement As Element ' Largest
Dim tElement As Long ' Total element count
Dim tEleGroups As Long ' Number of groups of elements
Dim tEle As Element
Dim e As Element
Dim EleCol As New Collection
Dim dbg As Boolean
dbg = False
Dim s As String, res As String, previousRes As String, inputString As String
Dim lCounter As Long
For i = 1 To UBound(v)
' Check if element already exists
On Error Resume Next
s = ""
s = EleCol.Item(v(i, 1))
On Error GoTo 0
' If not, create new
If s = "" Then
Set tEle = New Element
With tEle
.SetName = v(i, 1)
.SetTotal = CLng(v(i, 2))
End With
EleCol.Add Item:=tEle, Key:=tEle.Name
End If
Next i
For Each e In EleCol
' Find the largest element
If e.Total > lElementCount Then
lElementCount = e.Total
Set lElement = e
End If
' Count total elements
tElement = tElement + e.Total
' And groups
tEleGroups = tEleGroups + 1
' Generate inputstring
For k = 1 To e.Total
inputString = inputString + e.Name
Next k
Next e
' If the largest element is larger than the total remaining elements, we'll break rule 4
If lElement.Total - (tElement - lElement.Total) > 1 Then
Debug.Print "0"
GoTo EndForSomeReason
End If
' Bubble sort - lowest to highest
' Adapted from https://stackoverflow.com/a/3588073/4604845
Dim tmpE As Element
For x = 1 To EleCol.Count - 1
For y = 1 To EleCol.Count
If EleCol.Item(x).Total > EleCol.Item(y).Total Then
Set tmpE = EleCol.Item(y)
EleCol.Remove y
EleCol.Add tmpE, tmpE.Name, x
End If
Next y
Next x
' Weighted probability array
Dim pArr() As Variant, tmpProb As Double
ReDim Preserve pArr(1 To 2, 1 To EleCol.Count)
For u = 1 To UBound(pArr, 2)
Set pArr(2, u) = EleCol.Item(u)
tmpProb = tmpProb + pArr(2, u).Freq(tElement)
pArr(1, u) = tmpProb
Next u
' The meat of it
Dim r As Long, lBool As Boolean, sLen As Long, o As Double, t As Long
For j = 1 To tElement
Do
' Reset loop control
lBool = False
' Generate a random number between 1 and 100 _
to decide which group we pick a letter from
r = Rand1To100
For i = 1 To UBound(pArr, 2)
If r <= pArr(1, i) And Not r > pArr(1, i) Then
If dbg Then Debug.Print "Probability match: " & pArr(2, t).Name
t = i
Exit For
End If
Next i
Set tEle = EleCol.Item(t)
If dbg Then Debug.Print "Name: " & tEle.Name
' If the random group is different from the previous result, proceed
If tEle.Name <> previousRes Then
lBool = True
Else
If dbg Then Debug.Print "This was also the previous result - skipping"
End If
' If the use-frequency for the random group is lower than _
how many times it appears in the string, proceed
If lBool Then
o = Round((tEle.Used / tElement) * 100, 5)
If dbg Then Debug.Print "Freq: " & tEle.Freq(tElement)
If dbg Then Debug.Print "Used: " & tEle.UsedFreqI()
If dbg Then Debug.Print "res%: " & Round((Len(res) / tElement) * 100, 1)
If dbg Then Debug.Print "o : " & o
' check use-frequency against modeled frequency
If o < tEle.Freq(tElement) Then
If dbg Then Debug.Print "Proceed with " & tEle.Name
lBool = True
Else
lBool = False
End If
End If
If dbg Then Debug.Print "----------"
lCounter = lCounter + 1
Loop While (Not lBool And lCounter < 1000)
tEle.IncrementUsed
res = res + tEle.Name
previousRes = tEle.Name
Next j
' Generate results
Debug.Print "INPUT : " & inputString
Debug.Print "RESULT: " & res
EndForSomeReason:
End Sub
Function Rand1To100() As Long
Dim r As Long
Randomize
r = ((100 - 1) * Rnd + 1)
r = Round(r, 0)
Rand1To100 = r
End Function
Private Sub TestSort()
Dim v(1 To 4, 1 To 2) As String
v(1, 1) = "A"
v(1, 2) = "6"
v(2, 1) = "B"
v(2, 2) = "2"
v(3, 1) = "C"
v(3, 2) = "2"
v(4, 1) = "D"
v(4, 2) = "4"
Call NonRepeatSort(v)
End Sub
And you'll need this class module:
' * Class module named Element
Private pName As String
Private pTotal As Long
Private pUsed As Long
Private FrequencyCoefficient As Long ' Obsolete?
' Name
Public Property Get Name() As String
Name = pName
End Property
Public Property Let SetName(s As String)
pName = s
End Property
' Total
Public Property Get Total() As Long
Total = pTotal
End Property
Public Property Let SetTotal(t As Long)
pTotal = t
End Property
' Used
Public Property Get Used() As Long
Used = pUsed
End Property
Public Sub IncrementUsed()
pUsed = pUsed + 1
End Sub
' Freq coefficient
Public Property Get Freq(f As Long) As Double
' Where f is the total number of elements
'Freq = FrequencyCoefficient
Freq = Round((Me.Total / f) * 100, 5)
End Property
Private Property Let SetFreq(f As Long)
' Obsolete?
' Where f is the total number of elements
FrequencyCoefficient = Round((Me.Total / f) * 100)
End Property
' Used freq - internal
Public Property Get UsedFreqI() As Long
If Me.Used > 0 Then
UsedFreqI = Round((Me.Used / Me.Total) * 100)
'Debug.Print "UF: " & UsedFreqI
Else
UsedFreqI = 0
End If
End Property
' Used freq - external
Public Property Get UsedFreqE(f As Long) As Long
If Me.Used > 0 Then
UsedFreq = Round((Me.Used / f) * 100)
Else
UsedFreq = 0
End If
End Property
I was wondering why the following syntax does not work the way I thought it would in VBA, and what I should do to ensure it does;
For a = 1 To 10
For b = 1 To 10
For c = 1 To 10
If a <> b <> c Then
MsgBox (a & " " & b & " " & c)
End If
Next c
Next b
Next a
This is a simplified example, which can still be manually obtained with:
if a<>b and b<>c and c<>a then
But my actual intended code has 10 such variables multiple times, which makes it unfeasible with 55 unequal conditions, or likely for me to make a typo. I think there is a more efficient way but I have not found it.
Ps. My goal is to only have a message box pop up if all the variables are unique.
I have obtained my goal, though it can probably be done much more efficient than:
For a = 1 To 10
check(a) = True
For b = 1 To 10
If check(b) = False Then
check(b) = True
For c = 1 To 10
If check(c) = False Then
check(c) = True
For d = 1 To 10
If check(d) = False Then
check(d) = True
For e = 1 To 10
If check(e) = False Then
check(e) = True
MsgBox (a & " " & b & " " & c & " " & d & " " & e)
End If
check(e) = False
check(a) = True
check(b) = True
check(c) = True
check(d) = True
Next e
End If
check(d) = False
check(a) = True
check(b) = True
check(c) = True
Next d
End If
check(c) = False
check(a) = True
check(b) = True
Next c
End If
check(b) = False
check(a) = True
Next b
Next a
Here is an implementation of the Johnson-Trotter algorithm for enumerating permutations. It is a small modification of one that I wrote once when playing around with brute-force solutions to the Traveling Salesman Problem. Note that it returns a 2-dimensional array, which might consume a lot of memory. It is possible to refactor it so that it is a sub where the permutations are consumed rather than stored. Just replace the part of the code near the bottom (where the current permutation, perm, is stored in the array perms) by the code that uses the permutation.
Function Permutations(n As Long) As Variant
'implements Johnson-Trotter algorithm for
'listing permutations. Returns results as a variant array
'Thus not feasible for n > 10 or so
Dim perm As Variant, perms As Variant
Dim i As Long, j As Long, k As Long, r As Long, D As Long, m As Long
Dim p_i As Long, p_j As Long
Dim state As Variant
m = Application.WorksheetFunction.Fact(n)
ReDim perm(1 To n)
ReDim perms(1 To m, 1 To n) As Integer
ReDim state(1 To n, 1 To 2) 'state(i,1) = where item i is currently in perm
'state(i,2) = direction of i
k = 1 'will point to current permutation
For i = 1 To n
perm(i) = i
perms(k, i) = i
state(i, 1) = i
state(i, 2) = -1
Next i
state(1, 2) = 0
i = n 'from here on out, i will denote the largest moving
'will be 0 at the end
Do While i > 0
D = state(i, 2)
'swap
p_i = state(i, 1)
p_j = p_i + D
j = perm(p_j)
perm(p_i) = j
state(i, 1) = p_j
perm(p_j) = i
state(j, 1) = p_i
p_i = p_j
If p_i = 1 Or p_i = n Then
state(i, 2) = 0
Else
p_j = p_i + D
If perm(p_j) > i Then state(i, 2) = 0
End If
For j = i + 1 To n
If state(j, 1) < p_i Then
state(j, 2) = 1
Else
state(j, 2) = -1
End If
Next j
'now find i for next pass through loop
If i < n Then
i = n
Else
i = 0
For j = 1 To n
If state(j, 2) <> 0 And j > i Then i = j
Next j
End If
'record perm in perms:
k = k + 1
For r = 1 To n
perms(k, r) = perm(r)
Next r
Loop
Permutations = perms
End Function
Tested like:
Sub test()
Range("A1:G5040").Value = Permutations(7)
Dim A As Variant, i As Long, s As String
A = Permutations(10)
For i = 1 To 10
s = s & " " & A(3628800, i)
Next i
Debug.Print s
End Sub
The first 20 rows of output look like:
Also, 2 1 3 4 5 6 7 8 9 10 is printed in the immediate window. My first version used a vanilla variant away and caused an out-of-memory error with n = 10. I tweaked it so that perms is redimensioned to contain integers (which consume less memory than variants) and is now able to handle 10. It takes about 10 seconds on my machine to run the test code.
You could simply add a check right after the beginning of each inner loop, like follows
For a = 1 To 10
For b = 1 To 10
If b <> a Then '<-- this check will make sure subsequent inner loops shouldn't bother but for their loops variables
For c = 1 To 10
If c <> b Then '<-- same comment as preceeding one
For d = 1 to 10
If d <> c then MsgBox (a & " " & b & " " & c & " " & d) '<-- last check for last two variables
Next d
End If
Next c
End If
Next b
Next a
Try putting all those variables into the array and checking the array for duplicates, if none found, display the message box. Something like this:
Sub dupfind()
Dim ArrHelper(2) As Long
Dim k As Long
Dim j As Long
Dim ans As Long
Dim dupl As Boolean
Dim ArrAnswers() As Long
ans = 0
For a = 1 To 10
ArrHelper(0) = a
For b = 2 To 10
ArrHelper(1) = b
For c = 1 To 10
ArrHelper(2) = c
dupl = False
For k = 0 To UBound(ArrHelper) - 1
For j = k + 1 To UBound(ArrHelper)
If ArrHelper(k) = ArrHelper(j) Then
dupl = True
End If
Next j
Next k
If dupl = False Then
ReDim Preserve ArrAnswers(3, ans)
ArrAnswers(0, ans) = a
ArrAnswers(1, ans) = b
ArrAnswers(2, ans) = c
ans = ans + 1
End If
Next c
Next b
Next a
End Sub
Read your edit regarding storing permutations and changed the code a bit
I would like to filter a Listbox created from a list of values stored in a worksheet depending on text written in a textbox contained in the same userform.
My Listbox has 4 or 5 columns (depending on OptionField selection) and I would like to search all the columns for the text written.
Example: I write "aaa" in TextField and the Listbox should return a list based on all the lines whose column 1 or 2 or 3 or 4 or 5 contain "aaa".
Below my code to refresh the list on OptionField selection (this code does not produce any error, it is just to show how I create my list):
Sub RefreshList()
Dim selcell, firstcell As String
Dim k, i As Integer
Dim r as long
i = 0
k = 0
' reads parameters from hidden worksheet
If Me.new_schl = True Then
firstcell = Cells(3, 4).Address
selcell = firstcell
Do Until IsEmpty(Range("" & selcell & "")) And i = 2
If IsEmpty(Range("" & selcell & "")) Then i = i + 1
k = k + 1
selcell = Cells(1 + k, 7).Address(0, 0)
Loop
k = k - 1
selcell = Cells(1 + k, 7).Address(0, 0)
With Me.ListBox1
.ColumnCount = 4
.ColumnWidths = "50; 80; 160; 40"
.RowSource = ""
Set MyData = Range("" & firstcell & ":" & selcell & "")
.List = MyData.Cells.Value
For r = .ListCount - 1 To 0 Step -1
If .List(r, 3) = "" Or .List(r, 3) = "0" Then
.RemoveItem r
End If
Next r
End With
Else
firstcell = Cells(3, 11).Address
selcell = firstcell
Do Until IsEmpty(Range("" & selcell & "")) And i = 11
If IsEmpty(Range("" & selcell & "")) Then i = i + 1
k = k + 1
selcell = Cells(1 + k, 15).Address(0, 0)
Loop
k = k - 1
selcell = Cells(1 + k, 15).Address(0, 0)
With Me.ListBox1
.ColumnCount = 5
.ColumnWidths = "40; 40; 160; 40; 40"
.RowSource = ""
Set MyData = Range("" & firstcell & ":" & selcell & "")
.List = MyData.Cells.Value
For r = .ListCount - 1 To 0 Step -1
If .List(r, 3) = "" Or .List(r, 3) = "0" Then
.RemoveItem r
End If
Next r
End With
End If
End Sub
Finally I could come out with something!
Sub Filter_Change()
Dim i As Long
Dim Str As String
Str = Me.Filter.Text
Me.RefreshList
If Not Str = "" Then
With Me.ListBox1
For i = .ListCount - 1 To 0 Step -1
If InStr(1, LCase(.List(i, 0)), LCase(Str)) = 0 And InStr(1, LCase(.List(i, 1)), LCase(Str)) = 0 And _
InStr(1, LCase(.List(i, 2)), LCase(Str)) = 0 And InStr(1, LCase(.List(i, 3)), LCase(Str)) = 0 Then
.RemoveItem i
End If
Next i
End With
End If
End Sub
I know, the answer is couple of years old...
But I thought I'd share solution that works the best for me, because the filter is blazing fast even when there are thousands of items in the list. It is not without a "catch", though:
it uses a Dictionary object
Option Explicit
Dim myDictionary As Scripting.Dictionary
Private Sub fillListbox()
Dim iii As Integer
Set myDictionary = New Scripting.Dictionary
' this, here, is just a "draft" of a possible loop
' for filling in the dictionary
For iii = 1 To RANGE_END
If Not myDictionary.Exists(UNIQUE_VALUE) Then
myDictionary.Add INDEX, VALUE
End If
Next
myListbox.List = myDictionary .Items
End Sub
Private Sub textboxSearch_Change()
Dim Keys As Variant
Keys = myDictionary .Items
myListbox.List = Filter(Keys, textboxSearch.Text, True, vbTextCompare)
End Sub
Private Sub UserForm_Initialize()
Call fillListbox
End Sub