How To Close a UserForm Properly in Excel VBA? - excel

I need to close a UserForm from a procedure that is inside the general module. The following code is just a test. I cannot use Me once that I am out of the form module.
Private Sub btnCancel_Click()
On Error GoTo TreatError
Dim screen As Object
Set screen = UserForms.Add(Me.Name)
Unload screen
Leave:
Set screen = Nothing
Exit Sub
TreatError:
GoTo Leave
End Sub
What's missing in this code? When I press the Cancel button, nothing happens, well, the form still keeps loaded. This UserForm is ShowModal True.
thanks in advance.
Ok Pᴇʜ. Here you are:
Public Sub EditarCombo(nomeColuna As String, itemCombobox As Variant, novoValor As Variant)
On Error GoTo TratarErro
Dim planilha As Worksheet
Dim planRamais As Worksheet
Dim tela As UserForm
If ((itemCombobox & "") <> "") Then
If ((Trim(novoValor) & "") <> "") Then
If (itemCombobox <> Trim(novoValor)) Then
Set planilha = Worksheets("CombosRamais")
Set planRamais = Worksheets("Ramais")
EditarNaColuna planilha, nomeColuna, itemCombobox, novoValor
ExcluirDuplicadasNaColuna planilha, nomeColuna, novoValor
OrdemarColuna planilha, nomeColuna, True
RedefinirAreaColuna planilha, planRamais, nomeColuna
EditarNaColuna planRamais, nomeColuna, itemCombobox, novoValor
Else
MsgBox "Você deve digitar um novo valor para o item escolhido.", vbInformation + vbOKOnly, "Editar Item"
GoTo Sair
End If
Else
MsgBox "O campo de novo valor está vazio.", vbInformation + vbOKOnly, "Editar Item"
GoTo Sair
End If
Else
MsgBox "Escolha um item na lista para ser editado.", vbInformation + vbOKOnly, "Editar Item"
GoTo Sair
End If
Set tela = UserForms.Add(Replace(nomeColuna, "Col", "frmEditar"))
Unload tela
Sair:
Set tela = Nothing
Set planilha = Nothing
Set planRamais = Nothing
Exit Sub
TratarErro:
GoTo Sair
End Sub

Based on your comment to FunThomas' answer you would like to have a function like that
Public Function UnLoadFrm(formName As String)
Dim frm As Object
For Each frm In VBA.UserForms
If frm.Name = formName Then
Unload frm
Exit Function
End If
Next frm
End Function
Be careful when using it as it is case sensitive. It might also be a good idea to use frm.Hide instead of Unload frm but then you should also rename the function.

Don't unload forms - just hide them.
From the form itself, use Me.Hide.
If you want to hide the form within module code, use UserForm1.Hide.
Destroying a form, especially in the wrong moment, can lead to surprising behavior that is really hard to understand. If you want to know more, read about "Default Instances". Hiding a form simply hides it from the screen so that it is not visible for the moment, but stays in memory.
Update
My answer was mainly to point out that you shoudn't destroy a form. If the subroutine is called from different forms and you pass the control (eg comboBox) as parameter, you can use the Parent-property to get the form object and hide it:
Public Sub EditarCombo(nomeColuna As String, itemCombobox As Control, novoValor As Variant)
(...)
itemCombobox.Parent.Hide
(...)
End Sub

Related

Excel VBA Problem when adding an ImageCombo-ActiveX to a worksheet

I'm trying to add an ImageCombo-ActiveX control to an Excel worksheet by using the VBA-function .OLEObjects.Add(classtype:="MSComctlLib.ImageComboCtl.2", Top:=TopPos, Left:=LeftPos, Height:=0, Width:=0).
When doing so, the ImageCombo control is displayed on the worksheet in a preloaded state:
ImageCombo Preloaded State
When doing a check with Winspector Spy, it turned out then the ActiveX-Window is loaded as a child-window of an invisible window within Excel named as 'CtlFrameworkParking':
ActiveX control window
instead of being diplayed as an ImageCombo-control. To force this, I first have to make the worksheet window invisble and then redisplay it:
Status after Re-displaying the worksheet window
Finally, after manually scrolling down a line, the ImageCombo-control is diplayed at the desired location with the desired size.
Status after worksheet scroll
Reinspecting with Winspector Spy the ActiveX-Window now is located within the worksheet window:
final correct status
Is there any way to programatically force the ActiveX-Window to show in final state on the worksheet window, probably with some api calls?
I Solved the problem doing it the dirty way by adding the following lines:
Function ShowLanguageDropDown(TargetSheetName As String, Optional TopPos As Single = 0#, Optional LeftPos As Single = 0#, Optional SetVisible As Boolean = False) As MSComctlLib.ImageCombo
'---------------------------------------------------------------------------------------
' Procedure : ShowLanguageDropDown
' Author : Bernd Birkicht
' Date : 05.11.2022
' Purpose : inserts an image dropdown on the target sheet, requires prelodad OLE-objects on a SourceSheet
' containing the ImageDropdown and the to be associated pre-set ImageList-activeX control
'---------------------------------------------------------------------------------------
'
'........
Set TargetSheet = ActiveWorkbook.Sheets(TargetSheetName)
'........
With TargetSheet
.Visible = xlSheetHidden
.Visible = xlSheetVisible
.Activate
End With
Set TargetSheet = Nothing
CurrentScrollRow = ActiveWindow.ScrollRow
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = CurrentScrollRow
End function
These commands now do programmatically what I did manually before resulting in now correctly displaying the ImageDropdown control at the desired location on the worksheet.
I would welcome a more elegant solution.
I finally decided to to drop the approach of using an ImageCombo-ActiveX control directly on an Excel worksheet due to i encounterd a big bunch of problems with the ImageCombo-control further on.
When stopping the screen update, the Drop-down arrow within the control occasionally disappears and the control repaints not always fully. I was not able to fix this.
At the end of the day, I used the ImageCombo-ActiveX control within a modeless userform which is not affected at all from application screen updating or events processed by the application while the userform is displayed.
To prevent the userform from floating on the windows screen, I now attached the userform to the Excel-application window and cropped the userform frame around the ImageCombo-control.
Please find below the code:
Private Sub UserForm_Initialize()
'---------------------------------------------------------------------------------------
' Procedure : UserForm_Initialize
' Author : Bernd Birkicht
' Date : 10.11.2022
' Purpose : fills the image-Dropdownbox valid lnaguage entries
'---------------------------------------------------------------------------------------
'
Static BasicInit As Boolean
On Error GoTo UserForm_Initialize_Error
If BasicInit Then Exit Sub 'already initialised?
....
'adapt userform window to Dropbox size
Me.Height = Me!LanguageDropBox.Height
Me.Width = Me!LanguageDropBox.Width
With Me.LanguageDropBox
Set .ImageList = Nothing 'delete image list and import again
If .ImageList Is Nothing Then Set .ImageList = Me.LanguageSmallIconImageList
mlngptrCtlHwnd = .hwnd
.Locked = True
End With
PopulateComboItems Translate:=bTranslate
UserForm_Initialize_Exit:
Crop_UF_Frame
BasicInit = MakeChild(Me)
Exit Sub
UserForm_Initialize_Error:
Select Case Err.Number
Case Else
'MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Prozedur UserForm_Initialize aus Formular LanguageDropBoxForm"
'LogError Err.Number, Err.Description, "in Prozedur UserForm_Initialize aus Formular LanguageDropBoxForm"
ErrEx.CallGlobalErrorHandler ' Call the global error handler to deal with unhandled errors
Resume UserForm_Initialize_Exit:
End Select
End Sub
Private Sub Crop_UF_Frame()
'---------------------------------------------------------------------------------------
' Procedure : Crop_UF_Frame
' Author : Nepumuk https://www.herber.de/forum/archiv/1456to1460/1459854_Userform_komplett_ohne_Rand.html
' Date : 21.11.2015
' Purpose : crop the userform frame
' geändert : 11.11.2022 Bernd Birkicht
' ergänzt: Region eingrenzen auf einzelnes Control in der Userform
'---------------------------------------------------------------------------------------
'
Dim udtRect As RECT, udtPoint As POINTAPI
Dim lngptrStyle As LongPtr, lngptrRegion As LongPtr, lngParenthWnd As LongPtr
Static BasicInit As Boolean
On Error GoTo Crop_UF_Frame_Error
mlngptrHwnd = FindWindowA(GC_CLASSNAMEMSFORM, Caption)
lngptrStyle = GetWindowLongA(mlngptrHwnd, GWL_STYLE)
Call SetWindowLongA(mlngptrHwnd, GWL_STYLE, lngptrStyle And Not WS_CAPTION)
Call DrawMenuBar(mlngptrHwnd)
Call GetWindowRect(mlngptrHwnd, udtRect)
udtPoint.x = udtRect.right
udtPoint.y = udtRect.bottom
Call ScreenToClient(mlngptrHwnd, udtPoint)
'11.11.2022 set region
If mlngptrCtlHwnd = 0 Then 'Control in Userform gewählt?
'remove userform frame
With udtRect
.bottom = udtPoint.y
.left = 4
.right = udtPoint.x
.top = 4
End With
Else
'set region to WindowRect of the selected control
Call GetWindowRect(mlngptrCtlHwnd, udtRect)
End If
lngptrRegion = CreateRectRgnIndirect(udtRect)
Call SetWindowRgn(mlngptrHwnd, lngptrRegion, 1&)
Crop_UF_Frame_Exit:
Exit Sub
Crop_UF_Frame_Error:
Select Case Err.Number
Case Else
ErrEx.CallGlobalErrorHandler ' Call the global error handler to deal with unhandled errors
Resume Crop_UF_Frame_Exit:
End Select
End Sub
Private Function MakeChild(ByVal UF As UserForm) As Boolean
Dim DeskHWnd As LongPtr
Dim WindowHWnd As LongPtr
Dim UFhWnd As LongPtr
MakeChild = False
' get the window handle of the Excel desktop
DeskHWnd = FindWindowEx(Application.hwnd, 0&, "XLDESK", vbNullString)
If DeskHWnd > 0 Then
' get the window handle of the ActiveWindow
WindowHWnd = FindWindowEx(DeskHWnd, 0&, "EXCEL7", ActiveWindow.Caption)
If WindowHWnd > 0 Then
' ok
Else
MsgBox "Unable to get the window handle of the ActiveWindow."
Exit Function
End If
Else
MsgBox "Unable to get the window handle of the Excel Desktop."
Exit Function
End If
' get the window handle of the userform
Call IUnknown_GetWindow(UF, VarPtr(UFhWnd))
mlngptrOldParenthWnd = GetParent(UFhWnd)
If mlngptrOldParenthWnd = WindowHWnd Then Exit Function 'Assignment to Excel window already done
'make the userform a child window of the MDIForm
If (UFhWnd > 0) And (WindowHWnd > 0) Then
' make the userform a child window of the ActiveWindow
If SetParent(UFhWnd, WindowHWnd) = 0 Then
''''''''''''''''''''
' an error occurred.
''''''''''''''''''''
MsgBox "The call to SetParent failed."
Exit Function
End If
End If
MakeChild = True
End Function
call:
If Wb.ActiveSheet.Name = Translate_To_OriginalText(InitSheetName) And LanguageDropBoxUForm Is Nothing Then
LanguageDropBoxForm.Hide 'Lädt das Window ohne es anzuzeigen
If UserForms.count > 0 Then Set LanguageDropBoxUForm = UserForms(UserForms.count - 1)
LanguageDropBoxForm.Move 660#, 85#
LanguageDropBoxForm.Show vbModeless 'show Language-Select-Window modeless
endif

Yes/NO Message Box - Automatically press No If there is no response for 5 seconds [duplicate]

I am trying to generate a popup that closes after a given WaitTime in seconds.
I consulted this link and this link.
I tried to apply the method from "VBA Excel macro message box auto close"; my code is the following:
Sub TestSubroutine()
Dim TemporalBox As Integer
Dim WaitTime As Integer
Dim WScriptShell As Object
Set WScriptShell = CreateObject("WScript.Shell")
WaitTime = 1
TemporalBox = WScriptShell.Popup("The message box will close in 1 second.", _
WaitTime, "File processed")
End Sub
The popup is displayed but it never closes after one second.
Edit #1
Based on #Skip Intro comment, I have updated the code:
Sub TestSubroutine()
Dim WaitTime As Integer
WaitTime = 1
CreateObject("WScript.Shell").Popup "The message box will close in 1 second.", _
WaitTime, "File processed"
End Sub
However this does not solve the original issue, the popup does not close after 1 second.
Edit #2
This is the code suggested by #Glitch_Doctor, however it still doesn't work:
Sub TestSubroutine()
Dim TemporalBox As Integer
Dim WaitTime As Integer
Dim WScriptShell As Object
Dim test
Set WScriptShell = CreateObject("WScript.Shell")
WaitTime = 1
Select Case TemporalBox = WScriptShell.Popup("The message box will close in 1 second.", _
WaitTime, "File processed")
Case 1, -1
End Select
End Sub
I finally found a very simple solution - credits to #Orphid, see his answer in the following thread.
I did not solve the specific issue related to my original code, but I managed to create a PopUp that closes after a specified period of time. The code is the following:
Sub subClosingPopUp(PauseTime As Integer, Message As String, Title As String)
Dim WScriptShell As Object
Dim ConfigString As String
Set WScriptShell = CreateObject("WScript.Shell")
ConfigString = "mshta.exe vbscript:close(CreateObject(""WScript.Shell"")." & _
"Popup(""" & Message & """," & PauseTime & ",""" & Title & """))"
WScriptShell.Run ConfigString
End Sub
This works just fine.
Another approach (if your would not work at all).
Create a new userform named frm_Popup and add a label there named lbl_Message. Add the following void to userform code:
Public Sub StartProcess(iTime As Integer)
Me.lbl_Message.Caption = "The message box will close in " & iTime & " second(s)."
End Sub
then in your module:
Sub ShowMessage()
Dim iTimeToWait As Integer
iTimeToWait = 2
With frm_Popup
.Show False
Call .StartProcess(iTimeToWait)
End With
Application.OnTime Now + TimeValue("00:00:" & iTimeToWait), "HidePopup"
End Sub
Private Sub HidePopup()
Unload frm_Popup
End Sub
You're just missing the Select Case:
WaitTime = 1
Select Case TemporalBox = WScriptShell.Popup("The message box will close in 1 second.", _
WaitTime, "File processed")
Case 1, -1
End Select
I tested and it works...
Below code work for me, I added a 2-sec delay before the popup message appears. After 4-sec it auto disappear. I learn it from Mr. Dinesh Kumar Takyar. He added a 5-sec delay b4 popup appears. His youtube link
https://www.youtube.com/watch?v=x1nmqVRrq-Q&list=PLwC8syx0i_6nHjAogOm9m4oGBq40YHkXV&index=4
I think the key issue is you need a delay for the popup timer to work. Maybe the Excel application needs to run for a while b4 the popup appears.
Option Explicit
Const PopUpTime As Integer = 4
Sub ShellMessageBox()
Dim MsgBoxWithTimer As Integer
MsgBoxWithTimer=CreateObject("WScript.Shell").Popup("Put your message here", PopUpTime, _
"Notice!", 0)
End Sub
Sub startTimer()
Application.OnTime Now + TimeValue("00:00:02"), "ShellMessageBox"
End Sub
Private Sub Workbook_Open()
startTimer
End Sub
The following code works for me:
Sub TimeBasedPopUp()
Dim WaitTime As Integer
WaitTime = 1
Select Case CreateObject("WScript.Shell").Popup("The message box will close in 1 second.",_
WaitTime, "MS Excel")
Case 1, -1
End Select
End Sub

Display popup for a time period in Excel

I am trying to generate a popup that closes after a given WaitTime in seconds.
I consulted this link and this link.
I tried to apply the method from "VBA Excel macro message box auto close"; my code is the following:
Sub TestSubroutine()
Dim TemporalBox As Integer
Dim WaitTime As Integer
Dim WScriptShell As Object
Set WScriptShell = CreateObject("WScript.Shell")
WaitTime = 1
TemporalBox = WScriptShell.Popup("The message box will close in 1 second.", _
WaitTime, "File processed")
End Sub
The popup is displayed but it never closes after one second.
Edit #1
Based on #Skip Intro comment, I have updated the code:
Sub TestSubroutine()
Dim WaitTime As Integer
WaitTime = 1
CreateObject("WScript.Shell").Popup "The message box will close in 1 second.", _
WaitTime, "File processed"
End Sub
However this does not solve the original issue, the popup does not close after 1 second.
Edit #2
This is the code suggested by #Glitch_Doctor, however it still doesn't work:
Sub TestSubroutine()
Dim TemporalBox As Integer
Dim WaitTime As Integer
Dim WScriptShell As Object
Dim test
Set WScriptShell = CreateObject("WScript.Shell")
WaitTime = 1
Select Case TemporalBox = WScriptShell.Popup("The message box will close in 1 second.", _
WaitTime, "File processed")
Case 1, -1
End Select
End Sub
I finally found a very simple solution - credits to #Orphid, see his answer in the following thread.
I did not solve the specific issue related to my original code, but I managed to create a PopUp that closes after a specified period of time. The code is the following:
Sub subClosingPopUp(PauseTime As Integer, Message As String, Title As String)
Dim WScriptShell As Object
Dim ConfigString As String
Set WScriptShell = CreateObject("WScript.Shell")
ConfigString = "mshta.exe vbscript:close(CreateObject(""WScript.Shell"")." & _
"Popup(""" & Message & """," & PauseTime & ",""" & Title & """))"
WScriptShell.Run ConfigString
End Sub
This works just fine.
Another approach (if your would not work at all).
Create a new userform named frm_Popup and add a label there named lbl_Message. Add the following void to userform code:
Public Sub StartProcess(iTime As Integer)
Me.lbl_Message.Caption = "The message box will close in " & iTime & " second(s)."
End Sub
then in your module:
Sub ShowMessage()
Dim iTimeToWait As Integer
iTimeToWait = 2
With frm_Popup
.Show False
Call .StartProcess(iTimeToWait)
End With
Application.OnTime Now + TimeValue("00:00:" & iTimeToWait), "HidePopup"
End Sub
Private Sub HidePopup()
Unload frm_Popup
End Sub
You're just missing the Select Case:
WaitTime = 1
Select Case TemporalBox = WScriptShell.Popup("The message box will close in 1 second.", _
WaitTime, "File processed")
Case 1, -1
End Select
I tested and it works...
Below code work for me, I added a 2-sec delay before the popup message appears. After 4-sec it auto disappear. I learn it from Mr. Dinesh Kumar Takyar. He added a 5-sec delay b4 popup appears. His youtube link
https://www.youtube.com/watch?v=x1nmqVRrq-Q&list=PLwC8syx0i_6nHjAogOm9m4oGBq40YHkXV&index=4
I think the key issue is you need a delay for the popup timer to work. Maybe the Excel application needs to run for a while b4 the popup appears.
Option Explicit
Const PopUpTime As Integer = 4
Sub ShellMessageBox()
Dim MsgBoxWithTimer As Integer
MsgBoxWithTimer=CreateObject("WScript.Shell").Popup("Put your message here", PopUpTime, _
"Notice!", 0)
End Sub
Sub startTimer()
Application.OnTime Now + TimeValue("00:00:02"), "ShellMessageBox"
End Sub
Private Sub Workbook_Open()
startTimer
End Sub
The following code works for me:
Sub TimeBasedPopUp()
Dim WaitTime As Integer
WaitTime = 1
Select Case CreateObject("WScript.Shell").Popup("The message box will close in 1 second.",_
WaitTime, "MS Excel")
Case 1, -1
End Select
End Sub

UserForm Button Still Functioning When Disabled

I am disabling a button onclick, but it is still allowing the click.
Code is like below:
UsrForm.Field1.Value = ""
UsrForm.Field2.Value = ""
UsrForm.btn.Enabled = False
UsrForm.Repaint
/*Processing Occurs*/
UsrForm.Field1.Value = val1
UsrForm.Field2.Value = val2
UsrForm.btn.Enabled = True
However, if I double click or click a few times where the disabled button is, it still runs the method several times, despite being disabled.
I think we have a proper bug here. The solution posted by S Meaden does not work (at least, not in my testing). Here's what I trew together for testing:
Private Sub CommandButton1_Click()
Dim w As Date
Me.CommandButton1.Enabled = False
w = Now + TimeSerial(0, 0, 2)
Debug.Print "point 1: " & Now
Application.Wait w
Debug.Print "point 2: " & Now
Me.CommandButton1.Enabled = True
End Sub
Clicking it makes it gray out (as it should when disabling) and run the routine. Clicking twice however runs the routine twice. Because it prints the times, it is clear that the routines run in sequence, so it seams that excel (in my case excel, haven't tested with other applications) remembers the clicks, and when the routine finishes (and the button is enabled again) the routine is called. It runs 3 or 4 times in a row as well.
Because of this, implementing S Meaden's answer, like so:
Dim clicked as Boolean
Private Sub CommandButton1_Click()
Dim w As Date
If Not clicked Then
clicked = True
Me.CommandButton1.Enabled = False
w = Now + TimeSerial(0, 0, 2)
Debug.Print Now
Application.Wait w
Debug.Print "punt 2 (" & Now & ")"
Me.CommandButton1.Enabled = True
clicked = False
End If
End Sub
does not work either.
It seems that if the button is enabled after the routine is finished, the clicks that were placed during routine execution are discarded. So as a workaround, you could use:
Private Sub CommandButton1_Click()
Dim w As Date
Me.CommandButton1.Enabled = False
w = Now + TimeSerial(0, 0, 2)
Debug.Print "point 1: " & Now
Application.Wait w
Debug.Print "point 2: " & Now
Me.Button1_clicked = False
Application.OnTime (Now + 0.000001), "enable_commandbutton"
End Sub
with "enable_commandbutton" being:
Public Sub enable_commandbutton()
Dim uf As Object
Debug.Print "check"
For Each uf In VBA.UserForms
If uf.Name = "UserForm1" Then
uf.CommandButton1.Enabled = True
End If
Next uf
End Sub
in a normal codemodule.
It is not pretty, but it works.
That's interesting. I agree your code should work and I am puzzled by that. However, I'm the sort of guy who would code around and so here is some that uses a module level variable to keep note of whether the procedure is already running.
Option Explicit
Private mbAlreadyProcessing As Boolean
Private Sub btn_Click()
On Error GoTo ErrHandler
If Not mbAlreadyProcessing Then
mbAlreadyProcessing = True
'do some work
mbAlreadyProcessing = False
End If
Exit Sub
ErrHandler:
'here we remember to "re-enable"
mbAlreadyProcessing = False
'do some error handling
End Sub

Excel VBA: Why does event trigger twice?

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

Resources