I have a code which display the text of the cell underneath it. However, it seems that the Combobox just refuse to display the correct text. As you can see in the screenshot
The Text property is different from the displaying text. It's the previous value.
ScreenUpdating is True
The combobox is enabled
There is only 1 combobox, no other objects/shapes/buttons/forms. And a single table in this sheet.
Other information:
Problematic ComboBox is in sheet LinhKien, other comboboxes work fine. I don't know how to upload file here, so it's a 7 days link valid begin from 20220712 (YYYYMMDD)
The combobox is hidden when user is not selecting column 1 or select more than 1 cell. It becomes visible when a cell in column 1 is selected.
I have 2 other sheets with Comboboxes behave the exact same way (hidden when not in certain column, text comes from underneath cell) but they don't have this problem.
If the code is of relevant, here it is.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
DoEvents
If Selection.Count > 1 Then Exit Sub
If Application.CutCopyMode Then
searchBoxAccessories.Visible = False
Exit Sub
End If
If searchBoxAccessories Is Nothing Then
Set searchBoxAccessories = ActiveSheet.OLEObjects("SearchCombBoxAccessories")
End If
If Target.Column = 1 And Target.Row > 3 Then
Dim isect As Range
Set isect = Application.Intersect(Target, ListObjects(1).Range)
If isect Is Nothing Then GoTo DoNothing
isInitializingComboBox = True
GetSearchAccessoriesData
searchBoxAccessories.Activate
isInitializingComboBox = True 'This prevent "_Change" fires up when something changes
searchBoxAccessories.Top = Target.Top
searchBoxAccessories.Left = Target.Left
searchBoxAccessories.Width = Target.Width + 15
searchBoxAccessories.Height = Target.Height + 2
Application.EnableEvents = False 'Another attemp to prevent "_Change" fires up when something changes
searchBoxAccessories.Object.text = Target.text
Application.EnableEvents = True
searchBoxAccessories.Object.SelStart = 0
searchBoxAccessories.Object.SelLength = Len(Target.text)
searchBoxAccessories.Visible = True
isInitializingComboBox = False 'Screenshot is taken here
Set workingCell = Target
Else
DoNothing:
If searchBoxAccessories Is Nothing Then
Set searchBoxAccessories = ActiveSheet.OLEObjects("SearchCombBoxAccessories")
End If
If searchBoxAccessories.Visible Then searchBoxAccessories.Visible = False
End If
End Sub
_____________________
Public Sub GetSearchAccessoriesData()
Dim col2Get As String: col2Get = "3;4;5;6"
Dim dataSourceRg As Range: Set dataSourceRg = GetTableRange("PhuKienTbl")
If Not IsEmptyArray(searchAccessoriesArr) Then Erase searchAccessoriesArr
searchAccessoriesArr = GetSearchData(col2Get, dataSourceRg, Sheet22.SearchCombBoxAccessories)
End Sub
_____________________
Public Function GetSearchData(col2Get As String, dataSourceRg As Range, searchComboBox As ComboBox, _
Optional filterMat As String = "") As Variant
Dim filterStr As String: filterStr = IIf(filterMat = "", ";", "1;" & filterMat)
Dim colVisible As Integer: colVisible = 1
Dim colsWidth As String: colsWidth = "200"
Dim isHeader As Boolean
Dim colCount As Integer: colCount = Len(col2Get) - Len(Replace(col2Get, ";", "")) + 1
GetSearchData = GetArrFromRange(dataSourceRg, col2Get, False, filterStr)
With searchComboBox
.ColumnCount = colVisible
.ColumnWidths = colsWidth
.ColumnHeads = False
End With
Set dataSourceRg = Nothing
End Function
_____________________
Public Function GetArrFromRange(rg As Range, cols2GetStr As String, isHeader As Boolean, Optional colCriFilterStr As String = ";") As Variant
Dim col2Get As Variant: col2Get = Split(cols2GetStr, ";")
Dim arrRowsCount As Integer
Dim arrColsCount As Integer: arrColsCount = UBound(col2Get) + 1
Dim resultArr() As Variant
Dim iRow As Integer
Dim iCol As Integer
Dim criCol As Integer
If Len(colCriFilterStr) = 1 Then
criCol = 0
Else: criCol = CInt(Left(colCriFilterStr, InStr(colCriFilterStr, ";") - 1))
End If
Dim criStr As String: criStr = IIf(isHeader, "", Mid(colCriFilterStr, InStr(colCriFilterStr, ";") + 1))
If isHeader Then
arrRowsCount = 1
Else
If criCol <> 0 Then
arrRowsCount = WorksheetFunction.CountIf(rg.Columns(criCol), criStr)
Else
arrRowsCount = rg.Rows.Count
End If
End If
If arrRowsCount = 0 Then GoTo EndOfFunction
ReDim resultArr(1 To arrRowsCount, 1 To arrColsCount)
Dim wkCell As Range
Dim arrRow As Integer: arrRow = 1
For iRow = IIf(isHeader, 1, 2) To IIf(isHeader, 1, rg.Rows.Count)
If criStr = "" Then
For iCol = 1 To arrColsCount
resultArr(arrRow, iCol) = rg.Cells(iRow, CDbl(col2Get(iCol - 1))).Value
Next iCol
arrRow = arrRow + 1
Else
If rg.Cells(iRow, criCol).Value = criStr Then
For iCol = 1 To arrColsCount
resultArr(arrRow, iCol) = rg.Cells(iRow, CDbl(col2Get(iCol - 1))).Value
Next iCol
arrRow = arrRow + 1
End If
End If
Next iRow
EndOfFunction:
GetArrFromRange = resultArr
Erase resultArr
End Function
After weeks of frustration, I am please to announce that I found out the cause. It was the Freeze Panes that affects the display of combobox. Particularly, ComboBox placed in freezed column is not refreshed as frequently as in other cell. In that area, combobox almost act as it's disabled (visually). No text changes update even when you type, no selection/highlighting. I changed to only freeze upper rows and the combobox works just as expected. That's why my other comboboxes in other sheets behaved correctly.
I suspect that Excel tries to save resources by making the freezed part not as responsive. That behavior override Application.ScreenUpdating and not exposed to user.
Since this "feature" could be version specific, my system is Win 10 pro, Excel 16 pro plus.
Related
I have created the following code to insert form button if there is a value in column "A". I am trying to get the form buttons to be slightly smaller than the cell dimensions (not touch the cell walls). This is what I have so far:
Sub InsertButtons()
Dim i As Long
Dim shp As Object
Dim dblLeft As Double
Dim dblTop As Double
Dim dblWidth As Double
Dim dblHeight As Double
With Sheets("MailMerge")
dblLeft = .Columns("N:N").Left
dblWidth = .Columns("N:N").Width - 1
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
dblHeight = .Rows(i).Height -1
dblTop = .Rows(i).Top
If .Cells(i, 1).Value = Empty Then
Else
Set shp = .Buttons.Add(dblLeft, dblTop, dblWidth, dblHeight)
shp.OnAction = "SendEmail"
shp.Characters.Text = "Email"
End If
Next i
End With
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = False
End Sub
You need to subtract 2 from width and height. And add 1 to top and left:
dblLeft = .Columns("N:N").Left + 1
dblWidth = .Columns("N:N").Width - 2
dblHeight = .Rows(i).Height - 2
blTop = .Rows(i).Top + 1
I also recommend to use
If Not .Cells(i, 1).Value = Empty Then
Set shp = .Buttons.Add(dblLeft, dblTop, dblWidth, dblHeight)
shp.OnAction = "SendEmail"
shp.Characters.Text = "Email"
End If
instead of an empty If statement.
Dear stackoverflow community
At work I have to write a macro which should be able to hide rows based on numbers in a column. Those can be multiple ones in one cell and the input should also allow to show more than one number at a time.
for example:
row 1: 20, 30, 15
row 2: 20
row 3: 13, 76
So if I enter 20, 30, it should only show rows 1 & 2)
I usually code with Java / c# and Im new to VBA, so Id really appreciate help:
My plan was to show a input box and split those numbers into an array.
Then i wanna go through each row with a for-Loop, in which i added two for each loops to check if any numbers equal. If not, hide row. If so, show and then i want to exit both for each loops and go to the next row. To exit nested loops, i tried using a do while boolean but it doesnt seem to work.
Right now it only shows the rows with all the input numbers (only row1 in example).
Sub SortingTest()
Dim numbers() As String
myNum = Application.InputBox("Enter BKPS (separate multiples by , )")
numbers = Split(myNum, ",", -1, compare)
'Userinput Vars
Dim row As Integer
row = 1
Dim saveNumber As String
'Looping Vars
Dim existingNum As String
Dim existingNumsArray() As String
Dim checkRows As Long
Dim saveElement As String
Dim done As Boolean
done = False
' Range("B3").Value = 10
' Saves the Input as Array:
For Each Element In numbers
saveNumber = Element
Cells(2, row).Value = saveNumber
row = row + 1
Next Element
Dim b As Integer
Do While done = False
For b = 1 To 100 'hardcoded, should be length of document. b == row;
existingNum = Cells(b, 3).Value
existingNumsArray = Split(existingNum, ",", -1, compare)
' loop thru input numbers
For Each Element In numbers
saveElement = Element
'loop thru given numbers
For Each inputElement In existingNumsArray
If saveElement <> inputElement Then
Rows(b).Hidden = True
ElseIf saveElement = inputElement Then
Rows(b).Hidden = False
done = True
Exit For
End If
Next
Next
Next
Loop
End Sub
Thank you very much for you answer. Yours hid all the rows, so i adjusted it to show them.
Option Explicit
Function ArrOr(a As Variant, b As Variant) As Boolean
Dim runner As Variant
ArrOr = True
If IsArray(a) Then
For Each runner In a
If ArrOr(runner, b) Then Exit Function
Next
Else
For Each runner In b
If Trim(a) = Trim(runner) Then Exit Function
Next
End If
ArrOr = False
End Function
Sub SortingBKPS()
Dim numbers As Variant, vars As Variant, i As Long, xRows As Range
numbers = Split(Application.InputBox("Enter BKPS (separate multiples by , )"), ",")
With Sheets("Sheet1")
vars = .Range("B1", .Cells(.Rows.Count, 2).End(xlUp)).Value2
For i = 2 To UBound(vars)
.Rows(i).EntireRow.Hidden = True
If ArrOr(Split(vars(i, 1), ","), numbers) Then
If xRows Is Nothing Then
Set xRows = .Rows(i)
Else
Set xRows = Union(xRows, .Rows(i))
End If
End If
Next
xRows.EntireRow.Hidden = False
End With
End Sub
By splitting it up it is very easy to do:
Option Explicit
Function ArrOr(a As Variant, b As Variant) As Boolean
Dim runner As Variant
ArrOr = True
If IsArray(a) Then
For Each runner In a
If ArrOr(runner, b) Then Exit Function
Next
Else
For Each runner In b
If Trim(a) = Trim(runner) Then Exit Function
Next
End If
ArrOr = False
End Function
Sub SortingTest()
Dim numbers As Variant, vars As Variant, i As Long, xRows As Range
numbers = Split(Application.InputBox("Enter BKPS (separate multiples by , )"), ",")
With Sheets("Sheet1")
vars = .Range("B1", .Cells(.Rows.Count, 2).End(xlUp)).Value2
For i = 1 To UBound(vars)
If ArrOr(Split(vars(i, 1), ","), numbers) Then
If xRows Is Nothing Then
Set xRows = .Rows(i)
Else
Set xRows = Union(xRows, .Rows(i))
End If
End If
Next
xRows.EntireRow.Hidden = True
End With
End Sub
by running this code line by line, it should be pretty much self explaining (also knowing you have already some knowledge in "coding")
Still, if you have any questions, just ask ;)
You can also do it the following way:
Sub SortingTest()
Dim numbers As Variant
Dim RangeCompare As Range
Dim MyRow As Integer
Dim NumFound As Boolean
numbers = Application.InputBox("Please,list the values in this format: " & _
vbCrLf & "{value, value, value, ...}", _
Default:="{#, #, #}", Type:=64)
For MyRow = 1 To Cells(Rows.Count, 1).End(xlUp).row
Set RangeCompare = Range(Cells(MyRow, 1), Cells(MyRow, Columns.Count).End(xlToLeft))
NumFound = False
For Each rCell In RangeCompare
For Each Element In numbers
If rCell = Element Then
NumFound = True
Exit For
End If
Next Element
If NumFound = True Then Exit For
Next rCell
If NumFound = False Then
Rows(MyRow).Hidden = True
End If
Next MyRow
End Sub
I think it's easy to understand but feel free to ask for explanation.
I programmatically add elements from a database to a multicolumn listbox using this code :
Do While (Not rs.EOF)
ExistingSheetsListBox.AddItem
ExistingSheetsListBox.List(i, 0) = rs.Fields(0)
ExistingSheetsListBox.List(i, 1) = rs.Fields(1)
ExistingSheetsListBox.List(i, 2) = rs.Fields(2)
ExistingSheetsListBox.List(i, 3) = rs.Fields(3)
ExistingSheetsListBox.List(i, 4) = rs.Fields(4)
i = i + 1
rs.MoveNext
Loop
The insertion in the listbox works fine, but the column width is not always adapted to the length of the elements inserted in it, I would like to know how I can do so that the column width of each column is adapted to the text inserted into it.
EDIT : I used the solution proposed by #Excel Developers with the piece of code given by #HarveyFrench.
There is no autosize option, following sample code shows 2 ways to do this.
This does not take into account anything other than being a sample.
Class Module clsListCtrlWidths
'class option used so we can use Collection instead of an array.
Option Explicit
Public m_ColWidthMax As Long
Forms Module. Initialise somewhere
Dim l_ColumnWidths As Collection
Set l_ColumnWidths = New Collection
Forms Module functions
Private Function SetColWidth(stLen As String, ctCol1 As control, lPosCol As Long) As String
Dim stWidthTemp As String
If lPosCol > 0 Then
stWidthTemp = stLen & ";"
End If
Dim lTmpWidth As Long
Dim lColWidth As Long
lTmpWidth = ctCol1.Width
ctCol1.AutoSize = True
lColWidth = ctCol1.Width
ctCol1.AutoSize = False
ctCol1.Width = lTmpWidth
If l_ColumnWidths.Count > lPosCol Then
If l_ColumnWidths.Item(lPosCol + 1).m_ColWidthMax < lColWidth Then
l_ColumnWidths.Item(lPosCol + 1).m_ColWidthMax = lColWidth
Else
lColWidth = l_ColumnWidths.Item(lPosCol + 1).m_ColWidthMax
End If
Else
Dim clsColWidth As clsListCtrlWidths
Set clsColWidth = New clsListCtrlWidths
clsColWidth.m_ColWidthMax = lColWidth
l_ColumnWidths.Add clsColWidth
End If
stWidthTemp = stWidthTemp & lColWidth
SetColWidth = stWidthTemp
End Function
Following function takes listbox & calls on above function;
Private Function AutoSizeColsWidth(ByRef ctListCtrl As MSForms.ListBox)
Dim txtBoxDummy As control
Set txtBoxDummy = Me.Controls.Add("Forms.TextBox.1", "txtBoxDummy", False)
txtBoxDummy.AutoSize = True
Dim lRow As Long
Dim lCol As Long
Dim strColWidth As String
For lRow = 0 To ctListCtrl.ListCount - 1
For lCol = 0 To ctListCtrl.ColumnCount - 1
txtBoxDummy = ctListCtrl.List(lRow, lCol)
strColWidth = SetColWidth(strColWidth, txtBoxDummy, lCol)
Next lCol
Next lRow
ctListCtrl.ColumnWidths = strColWidth
End Function
Size Each time you add a single item
'assumes rs.Fields is a control or converted to control
Dim strColWidth As String
strColWidth = SetColWidth(strColWidth, rs.Fields(0), 0)
strColWidth = SetColWidth(strColWidth, rs.Fields(1), 1)
strColWidth = SetColWidth(strColWidth, rs.Fields(2), 2)
strColWidth = SetColWidth(strColWidth, rs.Fields(3), 3)
'etc
ctListCtrl.ColumnWidths = strColWidth
Or size once after adding lot of items
Call AutoSizeColsWidth(myListBox) 'call after completely loading listbox
Added as I was looking for a way to do this & OP is Google's top answer.
You can use the ColumnWidths property to set the size of the columns.
eg `ExistingSheetsListBox.ColumnWidths = "60;60;160;160;60"
For more info see here
I have not found anyway to automatically set the widths depending ont he data in each column, and I am pretty sure such a method does not exist.
Read the width of the existing column and assign it to a variable and use that in the listbox column property.
For Example You have six columns A to F and You need to auto fit the column F
FWidth = Columns("F").ColumnWidth * 7.6
ListBox1.ColumnWidths = "120,120,120,120,120," & FWidth & ""
The Multiply of 7.6 will converts the value to Points.
In Similar Way You can do it for all of Your columns.
Autosize Listbox and Combobox Columns with this function and Optionaly Resize Listbox/Combobox controls themselves.
Function ControlsResizeColumns(LBox As MSForms.Control, Optional ResizeListbox As Boolean)
Application.ScreenUpdating = False
Dim ws As Worksheet
If sheetExists("ListboxColumnWidth", ThisWorkbook) = False Then
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = "ListboxColumnwidth"
Else
Set ws = ThisWorkbook.Worksheets("ListboxColumnwidth")
ws.Cells.Clear
End If
'---Listbox/Combobox to range-----
Dim rng As Range
Set rng = ThisWorkbook.Sheets("ListboxColumnwidth").Range("A1")
Set rng = rng.Resize(UBound(LBox.List) + 1, LBox.ColumnCount)
rng = LBox.List
rng.Characters.Font.Name = UserForm1.ListBox1.Font.Name
rng.Characters.Font.Size = UserForm1.ListBox1.Font.Size
rng.Columns.AutoFit
'---Get ColumnWidths------
rng.Columns.AutoFit
Dim sWidth As String
Dim vR() As Variant
Dim n As Integer
Dim cell As Range
For Each cell In rng.Resize(1)
n = n + 1
ReDim Preserve vR(1 To n)
vR(n) = cell.EntireColumn.Width + 10 'if not some extra space it cuts a bit off the tail
Next cell
sWidth = Join(vR, ";")
Debug.Print sWidth
'---assign ColumnWidths----
With LBox
.ColumnWidths = sWidth
'.RowSource = "A1:A3"
.BorderStyle = fmBorderStyleSingle
End With
'----Optionaly Resize Listbox/Combobox--------
If ResizeListbox = True Then
Dim w As Long
For i = LBound(vR) To UBound(vR)
w = w + vR(i)
Next
DoEvents
LBox.Width = w + 10
End If
'remove worksheet
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Function
Function sheetExists(sheetToFind As String, Optional InWorkbook As Workbook) As Boolean
If InWorkbook Is Nothing Then Set InWorkbook = ThisWorkbook
On Error Resume Next
sheetExists = Not InWorkbook.Sheets(sheetToFind) Is Nothing
End Function
I am currently attempting to take user input and split each bit of input using a comma. Currently I am trying to use -
includer = CStr(InputBox("Do you have any inclusions? Separate words with commas"))
inclusion = Split(includer, ",", , vbTextCompare)
with no luck.
It keeps throwing a 'Type Mismatch' error.
The full code I am attempting to use, for anyone that is interested, is-
Option Compare Text
Public Sub Textchecker()
'
' Textchecker
'
' Keyboard Shortcut: Ctrl+h
'
Dim Continue As Long
Dim findWhat As String
Dim LastLine As Long
Dim toCopy As Boolean
Dim cell As Range
Dim item As Long
Dim j As Long
Dim x As Long
Dim sheetIndex As Long
Dim inclusion() As String
sheetIndex = 2
Continue = vbYes
Do While Continue = vbYes
findWhat = CStr(InputBox("What word would you like to search for today?"))
includer = CStr(InputBox("Do you have any inclusions? Separate words with commas"))
inclusion = Split(includer, ",", , vbTextCompare)
LastLine = ActiveSheet.UsedRange.Rows.Count
If findWhat = "" Then Exit Sub
j = 1
For item = 1 To LastLine
For Each cell In Range("BY1").Offset(item - 1, 0)
If InStr(cell.Text, findWhat) <> 0 And InStr(cell.Text, inclusion(x)) <> 0 Then
toCopy = True
End If
Next
If toCopy = True Then
Sheets(sheetIndex).Name = UCase(findWhat) + "+" + LCase(inclusion(x))
Rows(item).Copy Destination:=Sheets(sheetIndex).Rows(j)
j = j + 1
End If
toCopy = False
Next item
sheetIndex = sheetIndex + 1
Continue = MsgBox(((j - 1) & " results were copied, do you have more keywords to enter?"), vbYesNo + vbQuestion)
Loop
End Sub
Change
Dim inclusion As String
to
Dim inclusion() As String 'recommended in my opinion
or
Dim inclusion As variant
Edit
I see your use of inclusion later in the code. It looks like you need to iterate over your new array.
dim x as long 'put this at the top, rename as you'd like.
for x = lbound(inclusion) to ubound(inclusion)
'do stuff with inclusion(x), i other code here before but I'm not sure that it was right anymore.
next
Edit 2
For item = 1 To LastLine
If UBound(insulation) >= 0 Then
'write procedure for when inclusion are present
Else
'write 2nd procedure for when inclusions are not present
End If
Next item
I am looking for a method to compare a list of cell values to a certain reference value. If I would only need to compare the values I'd know how to achieve that. But here is the kicker: How can I look for a partial match? e.g.: the reference value should be "good". If the value of those cells would be "good" as well it should be considered a match. If the cell value is "Mr. goodcat" it should also be considered a match. My best guess would be to reference the original value to a string variable and put in some "*" if that would be possible.
Since I am not able to post some code, I don't need you to give me the whole answer, but a point in the right direction would be very nice. Thanks in advance guys.
edit: I have put in my final code. A short explaination: It loops through values in Sheet2 and compares them to values in column J in Sheet 1. If it finds a (partial) match, it highlights the cell.
Sub CompareValues()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws1Lrow As Long
Dim ws2Lrow As Long
Dim i As Integer
Dim x As Integer
Dim k As Integer
Dim reference As String
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
ws1Lrow = Worksheets("Sheet1").Range("A" & Worksheets("Sheet1").Rows.Count).End(xlUp).Row
ws2Lrow = Worksheets("Sheet2").Range("A" & Worksheets("Sheet2").Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To ws2Lrow Step 1
ws2.Select
Cells(i, 1).Select
reference = ActiveCell
ws1.Select
For x = 2 To ws1Lrow
k = InStr(1, Cells(x, 10), reference, vbTextCompare)
If k > 0 Then
Cells(x, 10).Interior.ColorIndex = 6
End If
Next x
Next i
End Sub
How about this?
Dim I As Integer
I = InStr(1, "Mr. goodcat", "good", vbTextCompare)
If I > 0 Then
' Match
Else
' No Match
End
Here's more advanced function which allows wildcards in the middle:
Function PatternMatch(ByVal SearchIn As String, ByVal Pattern As String) As Boolean
If Len(SearchIn) = 0 Or Len(Pattern) = 0 Then
PatternMatch = False
Exit Function
End If
Dim Position As Integer
Dim MatchFirst As Boolean
Dim MatchLast As Boolean
Dim Chunks() As String
MatchFirst = (Left(Pattern, 1) <> "*")
MatchLast = (Right(Pattern, 1) <> "*")
Chunks = Split(Pattern, "*")
LastChunkIndex = UBound(Chunks)
If MatchFirst Then
If Not (Left(SearchIn, Len(Chunks(0))) = Chunks(0)) Then
PatternMatch = False
Exit Function
End If
End If
If MatchLast Then
If Not (Right(SearchIn, Len(Chunks(LastChunkIndex))) = Chunks(LastChunkIndex)) Then
PatternMatch = False
Exit Function
End If
End If
Position = 1
For Each Chunk In Chunks
ChunkLength = Len(Chunk)
If ChunkLength > 0 Then
NextPosition = InStr(Position, SearchIn, Chunk, vbTextCompare)
If NextPosition > 0 And NextPosition >= Position Then
Position = NextPosition + ChunkLength
Else
PatternMatch = False
Exit Function
End If
End If
Next Chunk
PatternMatch = True
End Function