The following should happen:
1. UserForm with 2 RefEdit controls is shown
2. The first RefEdit is used to select a range
3. The RefEdit_Change event adjusts the second RefEdit control to .offset(0,1) of the range
Here my code until now:
Module1:
Dim frmSelectXY As New frmSelectImportData
With frmSelectXY
.Show
.DoStuffWithTheSelectedRanges
End With
UserForm: frmSelectImportData
Option Explicit
Private Type TView
IsCancelled As Boolean
xrng As Range
yrng As Range
End Type
Private this As TView
Public Property Get IsCancelled() As Boolean
IsCancelled = this.IsCancelled
End Property
Public Property Get yrng() As Range
Set yrng = this.yrng
End Property
Public Property Get xrng() As Range
Set xrng = this.xrng
End Property
'Here is where the fun happens
Private Sub RefEdit1_Change()
'RefEdit2.Value = RefEdit1.Value
If InStr(1, RefEdit1.Value, "[") <> 0 And InStr(1, RefEdit1.Value, "!") <> 0 Then
RefEdit2.Value = Range(RefEdit1.Value).offset(0, 1).Address(External:=True)
ElseIf InStr(1, RefEdit1.Value, "!") <> 0 Then
RefEdit2.Value = Range(RefEdit1.Value).offset(0, 1).Parent.Name & "!" & Range(RefEdit1.Value).offset(0, 1).Address(External:=False)
Else
RefEdit2.Value = Range(RefEdit1.Value).offset(0, 1).Address(External:=False)
End If
End Sub
Private Sub SaveBTN_Click()
Set this.xrng = Range(RefEdit1.Value)
Set this.yrng = Range(RefEdit2.Value)
If Not validate Then
MsgBox "x-values and y-values need to have the same size."
Else
Me.Hide
End If
End Sub
Function validate() As Boolean
validate = False
If this.xrng.count = this.yrng.count Then validate = True
End Function
RefEdit1_Change should adjust the value of RefEdit2 such that it will show the reference to the column just next to it or better .offest(0,1) to it.
But that isn't what happens.. the value doesn't get changed. As soon as the User clicks into RefEdit2 if RefEdit1 has already been changed, the program aborts without error message. If you Cancle the UserForm I have also experienced hard crashes of excel. I have temporarily fixed the problem by rebuilding the UserForm from scratch and renaming the RefEdits. But at some point it reapeared. It seems as if it is an Excel/VBA inherent problem.
Does anybody know how to fix this?
Ugly hacks and workarounds are welcome, anything is better than, abort without error message.
you need to enclose Range(RefEdit1.Value).offset(0, 1).Parent.Name in ' so
="'" & Range(RefEdit1.Value).offset(0, 1).Parent.Name & "'!"
Related
I'm currently a bit stuck with the "Object Variable or With block variable not set error".
Still fairly new to using With statements to simplify my code, I have two instances on my Class "ContractSelection" Both existing instances (previousContract & currentContract) are both by this time in the code called as public variables, and set with values. In this Sub I am attempting to submit one piece of information depending whether they are looking at the current selection or the previous (a toggle in the userform).
Frankly I'm not sure if contractToUpdate = currentContract is even a valid statement, but i'm finding it difficult to simply google.
(in a Public Variable module)
Public currentContract As ContractSelection
Public previousContract As ContractSelection
(in Userform module)
Private Sub UserForm_Initialize()
Set currentContract = New ContractSelection
Set previousContract = New ContractSelection
End Sub
Values are set in general Subs like this
Sub setThePreviousContractAsTheCurrent()
currentContract.DistrictNumber = previousContract.DistrictNumber
currentContract.ContractName = previousContract.ContractName
currentContract.RegionName = previousContract.RegionName
'...
End Sub
(In a Main Sub module) This Sub is where the issue is.
Sub submitNewCode()
Dim contractToUpdate As ContractSelection, response As Integer
Set contractToUpdate = New ContractSelection
If CDBENC_Form.chkbx_PreviousSearch.value = False Then
'vba stating the issue is here
contractToUpdate = currentContract
Else
contractToUpdate = previousContract
End If
With contractToUpdate
If .CodeOfContract <> "" Then
If isSimilarByOne(.CodeOfContract, CDBENC_Form.txt_Code.value) = False Then
dataSheet.Cells(.TheRowIWasFoundIn, dataMappedColumns.CodeColumnNum).value = CDBENC_Form.txt_Code.value
Else
response = MsgBox("The new code is close to the original, is " & CDBENC_Form.txt_Code.value & " the intended new code?", vbYesNo + vbQuestion, "Confirm Action")
If response = vbYes Then
dataSheet.Cells(.TheRowIWasFoundIn, dataMappedColumns.CodeColumnNum).value = CDBENC_Form.txt_Code.value
Else
Exit Sub
End If
End If
End If
End With
End Sub
I've tried checking for to see if for some reason currentContract is showing as nothing
this returns the else
If currentContract Is Nothing Then
MsgBox "Current Contract is nothing"
Exit Function
Else
MsgBox "Current Contract is not nothing"
End If
I've tried both
Dim contractToUpdate As ContractSelection
Dim contractToUpdate As New ContractSelection
also putting in the public variables as well
Public contractToUpdate As New ContractSelection
Any suggestions help, I feel as though I'm close to the idea but far from the solution.
VBA requires the use of Set when assigning a value to an object-typed variable.
So:
If CDBENC_Form.chkbx_PreviousSearch.value = False Then
Set contractToUpdate = currentContract
Else
Set contractToUpdate = previousContract
End If
If you're interested in why that's the case: https://stackoverflow.com/a/9924325/478884
I have a combobox with the properties MatchEntry 1-fmMatchEntryCompleteand MatchRequired True.
I need it true to prevent any invalid entry in the combobox. I dont want to make this a Style 2-fmStyleDropDownList but rather keep it a Style 0-fmStyleDropDownCombo because I have about 1000 items to choose from.
This setup works, except if you accidentally click in the combobox, and try to click out of it. You keep getting
Invalid Property Value
Is there anyway I could code the invalid entries so I don't have to assign the property to True?
Figured it out if anyone has this problem in the future. All I did was keep the properties above, and add this code to my userform for the combobox1.
Private Sub ComboBox1_Change()
If Me.ComboBox1.Value = "" Then
'Match not required if zero lenght string
Me.ComboBox1.MatchRequired = False
Else
'Match is required if other than zero length string
Me.ComboBox1.MatchRequired = True
End If
End Sub
You can use the combo LostFocus event. It will check if the value matches one of the combo entries, send a message in case of not, and delete the combo value. Or it can do something else, if my suggestion is not good enough:
Private Sub ComboBox1_LostFocus()
If ComboBox1.Value = "" Then Exit Sub
Dim cbVal As Variant, boolFound As Boolean, i As Long
cbVal = ComboBox1.Value
For i = 0 To ComboBox1.ListCount - 1
If cbVal = ComboBox1.list(i) Then boolFound = True: Exit For
Next i
If Not boolFound Then _
MsgBox "The value """ & cbVal & """ does not exist between the combo items" & vbCrLf & _
"It will be deleted", vbInformation, "Illegal entry": ComboBox1.Value = ""
End Sub
MatchRequired should remain False (default)...
So i have been at this for a while now and I have searched through many websites and forums but alas I can not find a solution to my issue.
I am trying to add arguments to an .OnAction event for a Checkbox
So.. For example
Dim chk as Checkbox
With chk
.name = "chk" & .TopLeftCell.Offset(0, -7).Text
.Caption = ""
.Left = cel.Left + (cel.Width / 2 - chk.Width / 2) + 7
.Top = cel.Top + (cel.Height / 2 - chk.Height / 2)
.OnAction = "CheckboxHandle(chk)"
End With
So if I was trying to call this sub -> Public Sub CheckboxHandle(obj As CheckBox)
It requries a CheckBox Object to be able to run (this can change to a shape/Object if necessary)
THINGS I HAVE TRIED
Changing the data type to object and shape however i couldn't find a way to pass it through
Variations of the below statements
"""CheckboxHandle(chk)"""
"'CheckboxHandle" ""chk"" '"
Application.caller then looping through objects to find the object whit that name (this takes way too long as I have over 300 Checkboxes)
CONTEXT
In case the context helps I am trying to add a checkbox to every cell in a range and then have each one call the same method when they are clicked. I need the OnAction to send an Object as i look for the TopleftCell of the Object to change the colour of the adjacent cells
IN CASE IT IS HELPFUL
here is the method i would like to call from the OnAction Event
Public Sub CheckboxHandle(obj As CheckBox)
Dim rng As Range
'Sneaky sneaky changes
Application.ScreenUpdating = False
'For Loop to go through each of the cells to the left of the check box
For Each rng In Range(obj.TopLeftCell, obj.TopLeftCell.Offset(0, -7))
With rng
'if the checkbox is checked
If obj.Value = -1 Then
.Interior.Color = RGB(202, 226, 188)
'Adds the date and the person so you know who did the edit
obj.TopLeftCell.Offset(0, 1).Value = Now & " by " & Application.username
Else
'if it isn't checked
.Interior.Pattern = xlNone
'removes the edit name and date
obj.TopLeftCell.Offset(0, 1).Value = ""
End If
End With
Next rng
'Shows all the changes at the same time
Application.ScreenUpdating = True
'Changes the value of the progress bar to represent the project completion
If obj.Value = -1 Then
ActiveSheet.Range("E1").Value = ActiveSheet.Range("E1").Value + 1 / 207
Else
ActiveSheet.Range("E1").Value = ActiveSheet.Range("E1").Value - 1 / 207
End If
End Sub
Any help on this issue would be much appreciated
-Sebic0
I don't think that you can pass an object via the OnAction. The OnAction-property is a string holding the name of a Sub (plus parameter).
You could try to pass the name of the checkBox instead. Note that you have to enclose the name of the checkbox in double quotes, so that you would get something like. CheckboxHandle "chk123":
.OnAction = "'CheckboxHandle """ & .Name & """'"
And change your Action-routine
Public Sub CheckboxHandle(chbBoxName as string)
dim chk as CheckBox
Set chk = ActiveSheet.CheckBoxes(chkBoxName)
(...)
Well I'm also new in VBA programming. I'm creating a form which helps me to do quotations, and then there is a part of my form that shows items I've already registered, like this:
My Form with ComboBoxes
So the purpose of those ComboBoxes is to change or delete the correponding item according with the option I choose, and I would have a lot of them in my UserForm, making it hard to create many ComboBox event programs (like ComboBox1_Change, ComboBox2_Change, ... ComboBox50_Change). And then, the main question is: how could I do it in VBA without loosing a lot of time making the same code for different objects? I would like to create just one code for all ComboBoxes.
I understand that I can do in this way below, but I'm sure that it has a better way to do.
Sub ComboBox1_Change()
Call myCode
End Sub
Sub ComboBox2_Change()
Call myCode
End Sub
Sub ComboBox50_Change()
Call MyCode
End Sub
Sub myCode()
For i=1 to 50
If Controls("ComboBox" & i).Value = "Change" Then
Call MySecondCode
End If
Next i
End Sub
I spent about 30 minutes searching about this question, but I didn't find anything good for me. I hope you guys understood my question. Thanks in advance.
Update:
Axel Richter, as I said in comments, I'm having problem in this:
Private Function isNOKTest()
If prod1.Value = "" Or _
prod2.Value = "" Or _
tecido.Value = "" Or _
tamanhos.Value = "" Or _
unitario.Value = "" Or _
quantidade.Value = "" Then
isNOKTest = True
End If
End Function
Private myCBsWithEvents As Collection
Private Sub UserForm_Initialize()
Set myCBsWithEvents = New Collection
For Each c In Me.Controls
If Left(c.Name, 8) = "ComboBox" Then
c.AddItem "CHANGE"
c.AddItem "DELETE"
Set myCBWithEvents = New clsCBWithEvents
Set myCBWithEvents.myCB = c
myCBsWithEvents.Add myCBWithEvents
End If
Next
End Sub
'
'
'
'datatext.Value = Format(Now, "dd/mm/yyyy")
'bordadoqty.Value = 1
'estampaqty.Value = 1
'Itemlab.Caption = 1
'
When any code is added to the project, the event in class module doesn't work, apparently isn't linked with "Events", but I don't know what happened.
This can be achieved using a class module which handles the events.
Insert a class module in your project. Name it clsCBWithEvents. In this class module have the following code:
Public WithEvents myCB As ComboBox
Private Sub myCB_Change()
If Me.myCB.Value = "Change" Then
MsgBox Me.myCB.Name & " has changed to ""Change"""
ElseIf Me.myCB.Value = "Delete" Then
MsgBox Me.myCB.Name & " has changed to ""Delete"""
End If
End Sub
In your user form have the following code:
Private myCBsWithEvents As Collection
Private Sub UserForm_Initialize()
Set myCBsWithEvents = New Collection
For Each c In Me.Controls
If TypeName(c) = "ComboBox" Then
c.AddItem "Change"
c.AddItem "Delete"
Set myCBWithEvents = New clsCBWithEvents
Set myCBWithEvents.myCB = c
myCBsWithEvents.Add myCBWithEvents
End If
Next
End Sub
Now every ComboBox in this user form will use this event handling.
I'm trying to avoid Event loops by disabling Events at crucial points. However, it doesn't always work. For instance, this code for a Combo box:
Private Sub TempComboS_Change()
Dim e
e = Application.EnableEvents
Application.EnableEvents = False
'
Application.EnableEvents = e
End Sub
The blank line is where the useful code goes; as it stands it obviously doesn't do anything. However, when I run it this way (with the blank line), it reaches "End Sub", then it goes back to the beginning and runs again. (This would make the useful code run twice).
Why is this happening?
EDIT: To clarify for the folks who've been helping me.
I have a macro that opens the dropdown list of the Combo box, activates it, then ends. It works properly. When I select an item from the open list, the Change event runs. This is the current version of the change event:
Private Sub TempComboS_Change()
End Sub
I put a breakpoint on the Private Sub line. It shows that this Change event runs, then runs again. I suspect that it has been doing this all along, and I noticed it now because I need to add code here.
I have no class modules or userforms. The controls are on a worksheet.
I'm going to try the "Run Once" suggestion, and I'll let you know if it works.
I tried the "Run Once" code you suggested. It sort of works, but I seem to have a bigger issue. When I select a drop-down list from a data-validated cell, the TempComboS_Change event triggers -- but not only didn't I touch this combo box, the cell isn't the LinkedCell for the combo box. In other words, it seems to be triggering by actions unconnected to the combo box!
Got to find out about that Call Stack thing...
Here is a bit of code to help investigate "sequence of events" issues
In a Standard Module
Public Enum eNewLine
No
Before
After
Both
End Enum
Public Function timeStamp(Optional d As Double = 0, Optional newLine As eNewLine = No, Optional Indent As Long = 0, _
Optional Caller As String, Optional Context As String, Optional message As String) As String
Dim errorMessage As String
If Err.number <> 0 Then
errorMessage = "ERROR: " & Err.number & ": " & Err.Description
Err.Clear
End If
If d = 0 Then d = Time
With Application.WorksheetFunction
timeStamp = .Text(Hour(d), "00") & ":" & .Text(Minute(d), "00") & ":" & .Text(Second(d), "00") & ":" & .rept(Chr(9), Indent)
End With
If Len(Caller) <> 0 Then timeStamp = timeStamp & Chr(9) & Caller
If Len(Context) <> 0 Then timeStamp = timeStamp & ": " & Chr(9) & Context
If Len(message) <> 0 Then timeStamp = timeStamp & ": " & Chr(9) & message
Select Case newLine
Case Before
timeStamp = Chr(10) & timeStamp
Case After
timeStamp = timeStamp & Chr(10)
Case Both
timeStamp = Chr(10) & timeStamp & Chr(10)
Case Else
End Select
If Len(errorMessage) <> 0 Then
timeStamp = timeStamp & Chr(9) & errorMessage
End If
End Function
At the top of each Module
'Module level Trace Hearder
Const debugEvents as Boolean = True
Const cModuleName As String = "myModuleName"
Const cModuleIndent As Long = 1
You can assign a module level indent for each module to organise the hierarchy an make it easy to understand.
In each Sub or Function (or property if you need)...
sub mySubName()
Const cMyName As String = "mySubName"
If debugEvents Then Debug.Print timeStamp(NewLine:=Before,Indent:=cModuleIndent, Caller:=cModuleName, Context:=cMyName, Message:="Start")
'Do stuff
If debugEvents Then Debug.Print timeStamp(NewLine:=After,Indent:=cModuleIndent, Caller:=cModuleName, Context:=cMyName, Message:="End")
End Sub
...Or you can use Me.Name for the Context if its a form or a sheet etc. and you can put whatever message or variable values you like in the Message.
You can also use a Timer (eg MicroTimer) and put the result in the Message section.
Here is an example output:
15:54:07: Roll-Up Select: Worksheet_Activate: Start: 3.24591834214516E-03
15:54:07: cDataViewSheet: Class_Initialize: Start
15:54:07: cRevealTarget: Class_Initialize: START
15:54:07: cRevealTarget: Class_Initialize: END
15:54:09: cDataViewSheet: startTimer: : START
15:54:09: cDataViewSheet: startTimer: init Timer
15:54:09: cOnTime: Class_Initialize
15:54:09: cOnTime: Let PulseTime: Inheret PulseTime from host sheet
15:54:09: cDataViewSheet: startTimer: : END
15:54:09: Roll-Up Select: Worksheet_Activate: END: 1.38736216780671
Private Sub cmbOrder_Change()
If cmbOrder = "" Then Exit Sub
Dim arr As Variant, maxorder As Integer
arr = Range("rngOrder")
maxorder = WorksheetFunction.Max(arr)
Dim errmsg As String, err As Boolean
err = False
errmsg = "This value must be a whole number between 1 and " & maxorder + 1
Dim v As Variant
v = cmbOrder.Value
If IsNumeric(v) = False Or (IsNumeric(v) = True And (v > maxorder + 1) Or v < 1)
Then
MsgBox errmsg
cmbOrder = ""
err = False
Else
txtOrder.Value = cmbOrder.Value
End If
End Sub
A bit late to the party but the problem of code repetition can be shown here in similar circumstances. Remove the first line of code and any error messages are dished out twice. This is because of the line that clears the ComboBox that is regarded as a change and picks up another error as null input is an error! May help someone with similar issue.
The Combobox_Change() will fire whenever there is a change in the combobox. For example
Option Explicit
Private Sub UserForm_Initialize()
ComboBox1.AddItem "Bah Blah"
End Sub
Private Sub CommandButton1_Click()
'~~> If something is selected in the combo then
'~~> this line will cause ComboBox1_Change to fire
ComboBox1.Clear
End Sub
Private Sub ComboBox1_Change()
MsgBox "A"
End Sub
So if you load the userform and select an item ComboBox1_Change will fire. You then use the commanbutton to clear the combo the ComboBox1_Change will again fire.
There is one more scenario when the change will again fire. When you change the combobox from the ComboBox1_Change event itself. Here is an example. And I believe this is what is happening in your case.
Scenario 1
Private Sub UserForm_Initialize()
ComboBox1.AddItem "Bah Blah"
End Sub
Private Sub ComboBox1_Change()
MsgBox "A"
ComboBox1.Clear
End Sub
Scenario 2
Private Sub UserForm_Initialize()
ComboBox1.AddItem "Bah Blah"
ComboBox1.AddItem "Bah Blah Blah"
End Sub
Private Sub ComboBox1_Change()
MsgBox "A"
ComboBox1.ListIndex = 1
End Sub
In the first scenario you can getaway with
Private Sub UserForm_Initialize()
ComboBox1.AddItem "Bah Blah"
End Sub
Private Sub ComboBox1_Change()
If ComboBox1 <> "" Then
MsgBox "A"
End If
End Sub
In the 2nd Scenario, you can use something like this
Dim boolRunOnce As Boolean
Private Sub UserForm_Initialize()
ComboBox1.AddItem "Bah Blah"
ComboBox1.AddItem "Bah Blah Blah"
End Sub
Private Sub ComboBox1_Change()
If boolRunOnce = False Then
MsgBox "A"
boolRunOnce = True
ComboBox1.ListIndex = 1
Else
boolRunOnce = False
End If
End Sub