This question already has answers here:
Weird behaviour of NOT
(3 answers)
VBA: Why would the Not operator stop working? [duplicate]
(3 answers)
Closed 2 years ago.
tl;dr: In the code below, the following two conditions both evaluate to True!!! How? Why?
If Not IsSaved Then
If IsSaved Then
I'm working with the VBA Visual Basic Editor (VBE) object. The .Saved property has me baffled.
Both (.Saved) and Not (.Saved) return True if the VBComponent object is in fact saved. I even tried explicitly coercing the property to a Boolean before evaluating the conditional. Here are the steps to reproduce:
Open a blank workbook in a new instance of Excel
Copy and run the following code from a standard module (e.g., "Module1"):
Sub ListModules()
Dim VBComp As Object 'VBComponent
For Each VBComp In Application.VBE.ActiveVBProject.VBComponents
Dim IsSaved As Boolean
IsSaved = CBool(VBComp.Saved)
If CStr(VBComp.Saved) = "True" Then
Debug.Print vbNewLine; VBComp.Name; " saved? "; VBComp.Saved; " ("; TypeName(VBComp.Saved); ")"
If Not IsSaved Then
Debug.Print VBComp.Name; " is not saved"
End If
If IsSaved Then
Debug.Print VBComp.Name; " is saved"
End If
End If
Next VBComp
End Sub
'Sample output:
ListModules
ThisWorkbook saved? True (Boolean)
ThisWorkbook is not saved
ThisWorkbook is saved
Sheet1 saved? True (Boolean)
Sheet1 is not saved
Sheet1 is saved
NOTE: To run this code, you may have to grant access to the VBA project object model: File -> Options -> Trust Center -> [Trust Center Settings...] -> Macro Settings -> [x] Trust access to the VBA project object model
#JMP and #SiddharthRout comments on question revealed the answer.
It's a non standard boolean implementation, where Trueis 1not -1.
But with that, logical operations fail.
E.g a Not A operation is the bitwise inversion of A (booleans are stored as long). If A=-1 its bits are 1111111111111111 and the inverson is 0000000000000000.
But if A=1 then its bits are 0000000000000001 and the inversion gets 1111111111111110 what is representing -2. So Not 1 is -2 what is True as it is <> 0!
That's why Not VBComponent.Saved = True (=-2) when VBComponent.Saved = True (=1) too!
| Assignment (a As Boolean) | Bits | Value As Integer | Value As Boolean |
|---------------------------|------------------|------------------|------------------|
| a = True | 1111111111111111 | -1 | TRUE |
| Not a | 0000000000000000 | 0 | FALSE |
| | | | |
| a = False | 0000000000000000 | 0 | FALSE |
| Not a | 1111111111111111 | -1 | TRUE |
| | | | |
| VBComponent.Saved = True | 0000000000000001 | 1 | TRUE |
| Not VBComponent.Saved | 1111111111111110 | -2 | TRUE |
| | | | |
| VBComponent.Saved = False | 0000000000000000 | 0 | FALSE |
| Not VBComponent.Saved | 1111111111111111 | -1 | TRUE |
Sub TestInversion()
Dim VBComp As Object 'VBComponent
Debug.Print
For Each VBComp In Application.VBE.ActiveVBProject.VBComponents
IsSaved = CInt(VBComp.Saved)
Debug.Print VBComp.Name; VBComp.Type; VBComp.Saved; CInt(VBComp.Saved); Not VBComp.Saved; Not CInt(VBComp.Saved); VBComp.Saved = True; VBComp.Saved = False
Next VBComp
End Sub
Now we are missing a reason for that strange implementation, maybe someone knows?
Related
I have a very large "work request" data set that I need to clean up. The data set has some consistent elements, a series of numbers that are a set length this changes about about half way through the data set but the change is predictable. One issue with the data set is that there are multiple deliminators in places, sometimes no deliminator, sometimes text in front etc. I pulled a sample of the variables that I am dealing with and separated them manually to show the desired result.
+----+--------------------------------+------------+--------+----------------------+
| | A | B | C | D |
+----+--------------------------------+------------+--------+----------------------+
| 1 | Work Request | Cell 1 | Cell 2 | Cell 3 |
| 2 | 2097947.A | 2097947 | A | |
| 3 | 2590082.A/4900 REPLACE DXAC | 2590082 | A | 4900 Replace DXAC |
| 4 | 2679314.C | 2679314 | C | |
| 5 | 2864142B/DEMOLISH STRUCTURES | 2864142 | B | DEMOLISH STRUCTURES |
| 6 | 3173618 | 3173618 | | |
| 7 | 3251628/4800 REPLACE ASPHALT | 3251628 | | 4800 REPLACE ASPHALT |
| 8 | 4109066A | 4109066 | A | |
| 9 | 4374312D | 4374312 | D | |
| 10 | 4465402, Building 4100 | 4465402 | | Building 4100 |
| 11 | 4881715 DESIGN | 4881715 | | DESIGN |
| 12 | 4998608\ | 4998608 | | |
| 13 | ADMIN | ADMIN | | |
| 14 | PGM MGMT | PGM MGMT | | |
| 15 | FWR # 4958989 /Bldg 4000 | 4958989 | | Bldg 4000 |
| 16 | NICC FEDISR000744416/4000 UPS | R000744416 | | 4000 UPS |
| 17 | R000451086/4300 MODS TO RM5006 | R000451086 | | 4300 MODS TO RM5006 |
+----+--------------------------------+------------+--------+----------------------+
As you can see there are a few predictable variables and some that are user input errors.
Notice that in some cases the numbers have a single character behind the 7 digit work request number most of the time separated by a "." but sometimes no separation as in A8 and A9. Sometime there are deliminators, "/" or "space", or "," but this isn't consistent. I am currently working with a VBA that manages to strip the numbers for some but fails when it encounters no numbers or extra numbers. Eventual the work request numbers were changed to add the R00 this is the "new" number and over half of the data uses this in some form.
The VBA that I am using:
Option Explicit
Public Function Strip(ByVal x As String, LeaveNums As Boolean) As Variant
Dim y As String, z As String, n As Long
For n = 1 To Len(x)
y = Mid(x, n, 1)
If LeaveNums = False Then
If y Like "[A-Za-z ]" Then z = z & y 'False keeps Letters and spaces only
Else
If y Like "[0-9. ]" Then z = z & y 'True keeps Numbers and decimal points
End If
Next n
Strip = Trim(z)
End Function
=NUMBERVALUE(Strip(A1,TRUE))
=Strip(A1,FALSE)
This works in some places but not others. It also doesn't separate out C and D respectively. The most important issue is stripping out the work request number as seen in B.
Thanks for any help.
Here's a function using Regular Expressions that returns an array of the results.
Option Explicit
'Set reference to Microsoft VBScript Regular Expressions 5.5
' or use late binding
Function Splitter(S As String) As String()
Dim re As RegExp, MC As MatchCollection
Const sPat As String = "^(?:\D*?(?=R?\d)(R?\d+)[,.]?([A-Z])?\s*[/\\]?\s*(.*\S)?)|\s*(.*\S)"
Dim sTemp(2) As String
Set re = New RegExp
With re
.Global = True
.MultiLine = True
.Pattern = sPat
If .Test(S) = True Then
Set MC = .Execute(S)
With MC(0)
sTemp(0) = .SubMatches(0) & .SubMatches(3)
sTemp(1) = .SubMatches(1)
sTemp(2) = .SubMatches(2)
End With
Splitter = sTemp
End If
End With
End Function
With the data in A2:An, if you have Excel O365 with dynamic arrays, you can enter:
B2: =Splitter(A2)
and fill down. The results of the array will spill right to columns C & D.
If you do not have dynamic arrays, then:
B2: =INDEX(Splitter($A2),COLUMNS($A:A))
Fill Right to D2. Then select B2:D2 and fill down as far as necessary.
Try this code
Private Sub UserForm_Click()
Dim Sp() As String: Sp = Split(Strip("2590082.A/4900 REPLACE DXAC"), "|")
Sheet1.Range("B2", Sheet1.Cells(RowIndex:=2, ColumnIndex:=UBound(Sp) + 2)).Value = Sp
End Sub
Function Strip(s As String) As String
If s = "" Then Exit Function
Dim tmp As String
tmp = s
Dim Sp() As String: Sp = Split("0,1,2,3,4,5,6,7,8,9,.", ",")
For i = 0 To 10
tmp = Replace(tmp, Sp(i), "|")
Next
Dim words As String
Sp = Split(tmp, "|")
For i = 0 To UBound(Sp)
If Sp(i) <> "" Then words = words & Sp(i) & "|"
Next
If Right$(words, 1) = "|" Then words = Mid(words, 1, Len(words) - 1)
tmp = s
Sp = Split(words, "|")
For i = 0 To UBound(Sp)
tmp = Replace(tmp, Sp(i), "|" & Sp(i) & "|")
Next
If Right$(tmp, 1) = "|" Then tmp = Mid(tmp, 1, Len(tmp) - 1)
Strip = tmp
End Function
Here's an example using a regular expression.
Sub WorkRequests()
Dim re As Object, allMatches, m, rv, sep, c As Range
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "(((R00)?\d{7})[\.]?([A-Z])?)"
re.ignorecase = True
re.MultiLine = True
re.Global = True
For Each c In Range("B5:B20").Cells 'for example
c.Offset(0, 1).Resize(1, 3).ClearContents 'clear output cells
If re.test(c.Value) Then
Set allMatches = re.Execute(c.Value)
For Each m In allMatches
c.Offset(0, 1).Value = m 'order#+letter
c.Offset(0, 2).Value = m.submatches(1) 'order #
c.Offset(0, 3).Value = m.submatches(3) 'letter
Next m
End If
Next c
End Sub
Regular expressions reference: https://learn.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/scripting-articles/ms974570(v=msdn.10)?redirectedfrom=MSDN
I have this table and the VBA code has to fetch Value from Product where the Primary value is Yes. But, Value has to be the First Value in the Sequence.
+---------+---------+---------+
| Product | Results | Primary |
+---------+---------+---------+
| A | | |
| B | | Yes |
| C | | Yes |
| D | | |
| E | | Yes |
| F | | |
| G | | Yes |
| H | | Yes |
| I | | |
+---------+---------+---------+
Expecting results:
+---------+---------+---------+
| Product | Results | Primary |
+---------+---------+---------+
| A | | |
| B | A | Yes |
| C | A | Yes |
| D | | |
| E | D | Yes |
| F | | |
| G | F | Yes |
| H | F | Yes |
| I | | |
+---------+---------+---------+
I have tried this below vba code, but doesn't work as i expected.
Sub test()
Dim i As Long
Dim lr As Long
lr = ActiveSheet.UsedRange.Rows.Count
For i = 2 To lr
If Range("D" & i).Value = "Yes" Then
Range("C" & i).Value = Range("B" & i - 1).Value
End If
Next
End Sub
Excel Formula
Here is an example of how your formula can look. This first looks to see if the primary field is "Yes". If so, then it checks if the previous result also was a yes, and grabs it's the result if so. Otherwise, it grabs the first value based on your example.
=IF($C2="Yes", IF($C1="Yes", $B1, $A1),"")
Adjust this as needed!
VBA Code
I would suggest creating a way of finding your headers, that way it is easier to update down the road in case it changes or there are more fields added. Below I added an example of what I would attempt to do.
I used a helper function (Inject) to build the actual formula and make it easier to read/debug if there are issues.
Feel free to add your own custom error handling as well.
Just note this is one of many ways you could tackle this. I could even break this formula into even smaller components to abstract as much of it as possible.
Option Explicit
Private Sub AddResultsToTable()
Dim Ws As Worksheet
Set Ws = ActiveSheet
'FIND COLUMN HEADERS TO USE IN FORMULA REFERENCES
With Ws.UsedRange
On Error GoTo Catch
Dim Product As Range
Set Product = .Find("Product")
Dim Results As Range
Set Results = .Find("Results")
Dim Primary As Range
Set Primary = .Find("Primary")
End With
'CREATE FORMULA. Example: =IF($C2="Yes", IF($C1="Yes", $B1, $A1),"")
Dim CustomFormula As String
CustomFormula = Inject("=IF(${0}='Yes', IF(${1}='Yes', ${2}, ${3}),'')", _
Primary.Offset(1).Address(False, True), _
Primary.Address(False, True), _
Results.Address(False, True), _
Product.Address(False, True) _
)
'SET FIRST RANGE EQUAL TO FORMULA & AUTOFILL FORMULA DOWN
With Results.Offset(1)
.Value = CustomFormula
.AutoFill Range(.Address, Ws.Cells(Ws.Rows.Count, Product.Column).End(xlUp).Offset(, 1))
End With
Exit Sub
Catch:
'You can do your error handling here.
MsgBox Err.Description, vbCritical
End Sub
'METHOD THAT ALLOWS A STRING TO BE REPLACED WITH VARIABLES AND SPECIAL CHARACTERS
Public Function Inject(ByVal Source As String, ParamArray Args() As Variant) As String
'#AUTHOR: ROBERT TODAR
'#EXAMPLE: Inject("${0}, ${1}!", "Hello", "Robert") --> Hello, Robert!
'REPLACE SINGLE QUOTES WITH DOUBLE QUOTES
Inject = Source
Inject = Replace(Inject, "'", """")
'REPLACE ${#} WITH VALUES STORED IN THE VALUE IN THAT INDEX.
Dim Index As Integer
For Index = LBound(Args, 1) To UBound(Args, 1)
Inject = Replace(Inject, "${" & Index & "}", Args(Index), , , vbTextCompare)
Next Index
End Function
Assuming cols A B C use the below formula in B2
=If(C2="yes", if(B1="",A1,B1),"")
Copy this to all the linea below.
This will work as long as the first item is not primary.
U can even include this formula in vba and do the copy paste in vba
This is a follow up to my previous question (Retrieving information of OLEObjects from Workbook with VBA)
Scenario: I am trying to retrieve data from a worksheet. The data might be normal strings or number or might be encased in check boxed (checked or not).
Data example:
+---------+-------+------------------+------+------------------+
| item1 | 2004 | | | |
+---------+-------+------------------+------+------------------+
| value x | rfd | checkbox for rfd | nfd | checkbox for nfd |
+---------+-------+------------------+------+------------------+
| ident | test7 | call3 | | |
+---------+-------+------------------+------+------------------+
Obs: In this example the "checkbox for rfd/nfd" is a normal checkbox (either form or activex), and depending on the item in that sheet, either might be selected.
Objective: What I am trying to do is read the worksheet in 2 steps: First read all the data that is directly called, so I use the code:
Sub Test_retrieve()
' this will get all non object values from the sheet
Dim array_test As Variant
Dim i As Long, j As Long
array_test = ThisWorkbook.Sheets(1).UsedRange
For i = 1 To ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To ThisWorkbook.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
ThisWorkbook.Sheets(2).Cells(i, j) = array_test(i, j)
Next j
Next i
End Sub
to get:
+---------+-------+------------------+------+------------------+
| item1 | 2004 | | | |
+---------+-------+------------------+------+------------------+
| value x | rfd | | nfd | |
+---------+-------+------------------+------+------------------+
| ident | test7 | call3 | | |
+---------+-------+------------------+------+------------------+
Next I am trying to reach all the objectives/shapes in my worksheet. I used the following code to get name, value (checked of not) and location of all activex objects:
Sub getavticeboxvalue()
' this will get the names and values (as binary) of all the activex controlbox objects in the sheet
Dim objx As Object
Dim i As Long
i = 1
For Each objx In ThisWorkbook.Sheets(1).OLEObjects
If objx.Object.Value = True Then
ThisWorkbook.Sheets(3).Cells(i, 1).Value = 1
ThisWorkbook.Sheets(3).Cells(i, 2).Value = objx.Name
ThisWorkbook.Sheets(3).Cells(i, 3).Value = objx.BottomRightCell.Address
ElseIf objx.Object.Value = False Then
ThisWorkbook.Sheets(3).Cells(i, 1).Value = 0
ThisWorkbook.Sheets(3).Cells(i, 2).Value = objx.Name
ThisWorkbook.Sheets(3).Cells(i, 3).Value = objx.BottomRightCell.Address
End If
i = i + 1
Next objx
End Sub
Which yields something like:
+-------+-----------+----------+
| value | name | location |
+-------+-----------+----------+
| 0 | checkbox1 | $C$2 |
+-------+-----------+----------+
| 1 | checkbox2 | $E$2 |
+-------+-----------+----------+
I would then proceed to feed the values (1s and 0s), to the first table, in the place where the checkboxes originally where (location).
Issue: When I try the same procedure for Form Control (instead of activex), I have less options, and although I can look for them (ThisWorkbook.Sheets(1).Shapes.Type = 8) I cannot find their name or location.
Question: Is there a way to find their name and location? Is there a more efficient way to reach the result?
Objective:
+---------+-------+------------------+
| item1 | 2004 | | | |
+---------+-------+------------------+
| value x | rfd | 0 | nfd | 1 |
+---------+-------+------------------+
| ident | test7 | call3 | | |
+---------+-------+------------------+
I have two sheets Lkups and dataResponseTimes. I am reading the data from
both initially into arrays.
I am then using the function GetAmbStpMappingsDict to create a dictionary of sorted lists from the array AmbSTPLkupArr.
Sample data from sheet dataResponseTimes:
| Category | Code | Amb | Incidents | Total (hours) | Mean (min:sec) | 90th centile (min:sec) | HCP incidents | Date | Processed Date |
|------------|---------|-----------------|-----------|---------------|----------------|------------------------|---------------|------------|------------------|
| Category 1 | England | England | 27703 | 18:36:00 | 00:07:55 | 00:13:44 | | 01/10/2017 | 02/02/2018 07:45 |
| Category 1 | RX9 | East Midlands | 4588 | 14:47:36 | 00:08:25 | 00:14:52 | | 01/10/2017 | 02/02/2018 07:45 |
| Category 1 | RYC | East of England | 0 | 00:00:00 | 00:00:00 | 00:00:00 | | 01/10/2017 | 02/02/2018 07:45 |
Sample data from sheet Lkups:
| Amb Code | STP |
|----------|---------------------------------|
| RYC | CAMBRIDGESHIRE AND PETERBOROUGH |
| RYC | HERTFORDSHIRE AND WEST ESSEX |
| RYC | MID AND SOUTH ESSEX |
| RX9 | DERBYSHIRE |
| RX9 | HUMBER, COAST AND VALE |
| ENGLAND | ENGLAND |
The idea being I create a structure such that there is a dictionary key e.g. 'RYC' and associated list e.g. Cambridgeshire etc.:
| RYC | CAMBRIDGESHIRE AND PETERBOROUGH |
| | HERTFORDSHIRE AND WEST ESSEX |
| | MID AND SOUTH ESSEX |
The code I have written creates the structure but in sub test I get the
Type mismatch (Error 13)
on line: Set sList = dict(key)
The sub PrintItems, adapted from an answer by #Thomas Inzina, can print out the contents of the dictionary dict, but trying to adapt this to use without a For Each loop is leading to the aforementioned error.
I am assuming this is because, without looping the keys, I am attempting to shortcut access the list in some way. Debugging shows that dict(key) is returning empty.
I don't want to deploy another loop if possible (i.e. of the keys). I have tried changing datatypes for sList, which, tbh, I didn't expect to work.
I would like to be able to loop testArr and use the value of testArr(rowIndex, 2), the code field from dataResponseTimes, to return the list from the dictionary, for that particular Code; e.g. If testArr(rowIndex, 2) were RYC I want the three items Cambridgeshire.... as previously described.
The end goal being that I will duplicate each row, in dataResponseTimes, the matching number of times, for the same Code, as in the list e.g. For RYC I will be duplicating the following row 3 times (once for each region in the lookup mapping (Lkups).
| Category 1 | RYC | East of England | 0 | 00:00:00 | 00:00:00 | 00:00:00 | | 01/10/2017 | 02/02/2018 07:45 |
So, a shorter route might be simply to access via the Code, as a key, the associated sList.Count. The original reason for trying to access the actual list values was that I was going to append the list value e.g. CAMBRIDGESHIRE AND PETERBOROUGH to the row.
Please could someone help me resolve this?
Code:
Option Explicit
Public Sub test()
'Tools > references > ms scripting runtime
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("dataResponseTimes")
Dim dict As Dictionary
Set dict = GetAmbStpMappingsDict
Dim testArr()
testArr = sht.Range("A2:J4").Value
Dim rowIndex As Long
For rowIndex = LBound(testArr, 2) To UBound(testArr, 2)
Dim sList As Variant, stpName As String
Dim x As Long
Dim key As Variant
key = testArr(rowIndex, 2) 'testArr(rowIndex, 2) is a Variant/string
Set sList = dict(key) 'Error
For x = 0 To sList.Count - 1
stpName = sList.GetKey(x)
Debug.Print stpName
Next
Next rowIndex
End Sub
Public Function GetAmbStpMappingsDict() As Dictionary
Dim dict As New Scripting.Dictionary
Dim AmbSTPLkupArr As Variant
AmbSTPLkupArr = ThisWorkbook.Worksheets("Lkups").Range("A2:B7").Value
Dim rowIndex As Long
For rowIndex = LBound(AmbSTPLkupArr, 1) To UBound(AmbSTPLkupArr, 1)
If Not dict.Exists(AmbSTPLkupArr(rowIndex, 1)) Then
dict.Add AmbSTPLkupArr(rowIndex, 1), CreateObject("System.Collections.SortedList")
dict(AmbSTPLkupArr(rowIndex, 1)).Add AmbSTPLkupArr(rowIndex, 2), AmbSTPLkupArr(rowIndex, 1)
Else
dict(AmbSTPLkupArr(rowIndex, 1)).Add AmbSTPLkupArr(rowIndex, 2), AmbSTPLkupArr(rowIndex, 1)
End If
Next rowIndex
Set GetAmbStpMappingsDict = dict
End Function
Sub PrintItems(dict As Object) 'Modified from code by #Thomas Inzina
Dim sList As Variant, ambTrust As Variant, stpName As String
Dim x As Long
For Each ambTrust In dict
Set sList = dict(ambTrust)
Debug.Print "Parent Dictionary ambTrust: "; ambTrust
For x = 0 To sList.Count - 1
stpName = sList.GetKey(x) 'sList.GetByIndex(x)
Debug.Print stpName
Next
Next
End Sub
Credit goes to #Rory for correctly identifying the issue.
1) I had failed to spot the difference in case for one item in the lookup table/sheet (Lkups) versus the data sheet dataResponseTimes. As #Rory states, the keys here are case sensitive. Changing England to ENGLAND; And,
2) Correcting a transcription error for the loop i.e.
For rowIndex = LBound(testArr, 1) To UBound(testArr, 1) not For rowIndex = LBound(testArr, 2) To UBound(testArr, 2) resolved the issue.
I need a little help, or a VBA script that can convert a big dataset (960000 rows) in the format like below. All the data are in one column
TRIP_ID | OBJECTID | CPR_VEJNAV | ADM_VEJSTA | ADM_VEJKLA | vejid | vejkl | Shape_Length
2626 | value | value | value | value | value | value | value
..
..
2626 | value | value | value | value | value | value | value
64646 | value | value | value | value | value | value | value
..
..
..
64646 | value | value | value | value | value | value | value
I would like to convert the data into multiple columns, one column for each TRIP_ID, like this:
TRIP_ID | ..... | TRIP_ID ..... | And so on
2626 | ..... | 64646 .....
..
..
2626 | ...... | 64646 .....
And so on, I have around 1800 TRIP_ID's
In short terms:
Convert from one long column, to multiple columns based on TRIP_ID
Always make a backup of your data before running someone else's code
Sub SplitToColumns()
Dim rCell As Range
Dim sCurrent As String
Dim rLast As Range
Dim lRowStart As Long
Application.EnableEvents = False
Set rLast = Sheet1.Range("A2").End(xlDown).Offset(1, 0)
rLast.Value = "End"
For Each rCell In Sheet1.Range("A2", rLast).Cells
If Split(rCell.Value, "|")(0) <> sCurrent Then
If lRowStart > 1 Then
rCell.Offset(lRowStart - rCell.Row, 0).Resize(rCell.Row - lRowStart, 1).Copy
Sheet1.Cells(2, Sheet1.Columns.Count).End(xlToLeft).Offset(0, 1).Resize(rCell.Row - lRowStart, 1).PasteSpecial xlValues
End If
lRowStart = rCell.Row
sCurrent = Split(rCell.Value, "|")(0)
End If
Next rCell
rLast.ClearContents
Application.CutCopyMode = False
Application.EnableEvents = True
End Sub