I am really sorry if this is a silly question. I would like to display a message box similar to the Immediate window that will sit "always on top" and scroll a countdown while not interrupting the VBA program.
I am essentially crunching numbers for 40,000 rows and each run takes about 15 minutes. I don't know if it's still running or when the current VBA code will complete.
Does anyone have suggestions?
Use the status bar:
Application.StatusBar = "Row " & rowNum & " of " & rowCount
At the end, to clear the status bar:
Application.StatusBar = False
You can do it by displaying modeless user form. Below is an example how to do this.
In order to make this example working properly you need to add new, empty UserForm to your project and change it name to frmProgress.
Sub test()
Dim form As frmProgress
Dim lblProgress As Object
Dim i As Long
'-------------------------------------------------
'Create an instance of user form and show it modeless on the screen.
Set form = New frmProgress
With form
.Width = 200
.Height = 60
.Caption = "Progress"
'Add label for displaying text...
Set lblProgress = .Controls.Add("Forms.Label.1", "lblProgress")
'... and format it to meet your requirements.
With lblProgress
.Width = 200
.Height = 60
.TextAlign = fmTextAlignCenter
.Font.Size = 12
.Top = 6
End With
Call .Show(vbModeless)
End With
For i = 1 To 100000
'(Some code ...)
DoEvents
'Here the new text is inserted on the message box.
lblProgress.Caption = i
Next i
Call form.Hide
End Sub
Related
So I have a multipage where I want the same button to show on both pages. I could place it outside but the border from the multipage is so ugly so I tried to place everything on the pages. Unfortunately you can't name the items (such as the combobox) with the same name. Is there a workaround to remove the borders and just show the page names or have the same name on the item on two pages?
Had some fun with this goal.
Consider this UserForm in Editor with TabStrip, 2 frames and some other controls.
Frames are named from Frame0, Frame1, etc.
Assuming the Frame0 is the location reference and first to display when UserForm is displayed, code below will be what you want.
Code:
Option Explicit
Private Sub TabStrip1_Change()
Dim i As Long, lActiveTabIndex As Long
lActiveTabIndex = Me.TabStrip1.Value
For i = 0 To Me.TabStrip1.Tabs.Count - 1
Me.Controls("Frame" & i).Visible = (i = lActiveTabIndex)
Next i
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
With Me
.Height = 288 ' Adjust to your desired height
' Align all FrameX top/left to same as Frame0, delete Caption and SpecialEffect
For i = 0 To Me.TabStrip1.Tabs.Count - 1
With Me.Controls("Frame" & i)
.Top = Me.Frame0.Top
.Left = Me.Frame0.Left
.Caption = ""
.SpecialEffect = fmSpecialEffectFlat
End With
Next i
End With
' Ensure frame for first tab is displayed
TabStrip1_Change
End Sub
Userform first load (didn't save screenshot, neither the workbook, sorry).
Next tab clicked:
I need to create ComboBox's and then AddItems to each ComboBox. This will all be done to a userform. I need to do this entirely within the VBA code, this is because each time the userform is opened new information will be shown.
this is what I have so far:
Private Sub UserForm_Initialize()
for i = 1 to size
Set CmbBX = Me.Controls.Add("Forms.ComboBox.1")
CmbBX.Top = ((90 * i) - 18) + 12 + 20
CmbBX.Left = 30
CmbBX.Text = "Please select an item from the drop down"
CmbBX.TextAlign = fmTextAlignCenter
CmbBX.Width = 324
CmbBX.Visible = False
CmbBX.Name = "ComBox2" & i
Next
end sub
the problem is, once each ComboBox is created its like its name isnt there. I cannot referance the combobox. this is what I have tried:
ComBox21.AddItems "Test1"
ComBox22.AddItems "Test2"
And it errors out. When I look at the UserForms function bar at the top of the screen (where I would usually select ComBox22_Change() for example), It shows that no ComboBoxes even exist!
Any Ideas on how to dynamically create and additems to comboboxes?
Thank you in advance
Here an sample of the code.
You need still to change it for you needs but this will be easy.
I have created a simple userform and one button to do test and it works fast.
To imput the comboboxes replace ".additem" with a loop to load each of them.
How to do that -- search in google
how to Populate a combobox with vba
You cannot refferance any controls on userform if they dont exist.
You need to search for them after creation and then modify them.
Example below with button code.
I think this should bring you to an idea how to manage this.
Option Explicit
Private Sub CommandButton1_Click()
Dim refControl As Control, frm As UserForm
Dim x
Set frm = Me
With Me
For Each x In Me.Controls
If TypeName(x) = "ComboBox" Then
Select Case x.Name
Case "cmbDemo3"
MsgBox "works!"
'here you can put your code
End Select
MsgBox x.Name
End If
Next x
End With
End Sub
Private Sub UserForm_Initialize()
Dim combobox_Control As Control
Dim i
For i = 0 To 5
Set combobox_Control = Controls.Add("forms.combobox.1")
With combobox_Control
.Name = "cmbDemo" & i
.Height = 20
.Width = 50
.Left = 10
.Top = 10 * i * 2
.AddItem "hihi" 'here you can add your input code
End With
Next i
End Sub
I am trying to create a function which programmatically adds text boxes to a blank userform depending on the users desired number of textboxes.
Currently I have a function which does this, however I cannot save the values of the text boxes. I have tried referencing the textboxes several ways however none of them seem to work (despite the same methods working before in a separate code, although the textboxes in question were not programmatically added)
Function addtxtbox(number_of_textboxes As Integer)
Dim option_names As New UserForm2
Dim names As String
Dim test As String
Dim textbox As Object
Dim submit As Object
For i = 1 To number_of_textboxes
Set textbox = option_names.Controls.Add("Forms.textbox.1")
With textbox
.Left = 30
.Width = 200
.Top = 20 * i
.Left = 20
End With
MsgBox (textbox.Name)'used to find the name of the textboxes
Next
option_names.Show
names = "TextBox1" 'correct name of the 1st textbox according to the msgbox above.
MsgBox (names) 'msgbox is always blank
test = option_names.names 'Compile error: Method or data members not found
'test = textbox.TextBox1.Value 'run time error 418 object does not support this property or method
MsgBox (test)
End Function
It is easier to name your textboxes with a predictable sequence:
For i = 1 To number_of_textboxes
Set textbox = option_names.Controls.Add("Forms.textbox.1")
With textbox
.Left = 30
.Width = 200
.Top = 20 * i
.Left = 20
.Name = "dynamic_" & i '<<<<<<< name the textbox
End With
MsgBox (textbox.Name)'used to find the name of the textboxes
Next
Now you can use something like:
For i = 1 To number_of_textboxes
MsgBox "Textbox# " & i & " has value '" & _
Me.Controls("dynamic_" & i).Text & "'"
Next
My issue concerns deleting textboxes dynamically on my userform. On the userform there is a spin button which the user can use to create textboxes at their discretion. As I spin the spin button upwards it will create text boxes up to a maximum amount which I set. However when I spin the button backwards it will only delete the most recently created text box and will not delete any more.
The Code creating the boxes is as follows
Private Sub AgendaFromBox_Change()
Dim BoxValue As Integer
BoxValue = AgendaFromBox.Value
If BoxValue > 10 Then
AgendaFromBox.Value = 10
Exit Sub
End If
If BoxValue = 0 Then
Exit Sub
End If
Dim NewBox As Control
Dim NewLabel As Control
For i = 1 To BoxValue
Set NewBox = Me.Controls.Add("Forms.Textbox.1")
Set NewLabel = Me.Controls.Add("Forms.Label.1")
With NewBox
.Name = "AgendaBox" & i
.Top = 100 + 30 * i
.Left = 20
.Width = 100
.Height = 20
.ControlSource = "'Hidden'!C" & 2 + i
End With
With NewLabel
.Name = "AgendaLabel" & i
.Top = 100 + 30 * i
.Left = 5
.Width = 14
.Height = 20
.Caption = i & "."
End With
Worksheets("Hidden").Range("B" & 2 + i) = i
Next i
NumOutBefore = BoxValue
End Sub
This code is part of a change event for a textbox that is linked to the spin button. The code for deleting the boxes is as follows.
Private Sub AgendaFromSpinner_Change()
AgendaFromBox.Value = AgendaFromSpinner.Value
Dim BoxValue1 As Integer
Static NumOutBefore As Integer
BoxValue1 = AgendaFromBox.Value
If BoxValue1 > 9 Then Exit Sub
If BoxValue1 < 1 Then Exit Sub
If BoxValue1 < NumOutBefore Then
Controls.Remove "AgendaBox" & i
Controls.Remove "AgendaLabel" & i
End If
NumOutBefore = AgendaFromSpinner.Value
End Sub
This code is part of the spin button change event. Any thoughts or ideas would be helpful. Thank you in advance.
I think this is what's happening in your code. If you set a break point on the first line of each module, then step through the code after clicking the spinner up/down buttons, you should be able to verify this:
Spinner starts at 0
Click the spinner UP button.
Spinner value is incremented
Box value is incremented.
AgendaFromBox_Change() gets triggered and builds AgendaBox1
Spinner UP button is clicked
Spinner value is incremented
Box value is incremented.
AgendaFromBox_Change() gets triggered and builds AgendaBox1 & AgendaBox2
You now have 2 copies of Agendabox1.
Since VBA won't like that, the second one gets automatically renamed to something
Spinner UP button is clicked
Spinner value is incremented
Box value is incremented.
AgendaFromBox_Change() gets triggered and builds AgendaBox1, AgendaBox2 & AgendaBox3
You now have 2 copies of Agendabox2 and 3 copies of AgendaBox1
VBA automatically renames the duplicates to something
Spinner DOWN button is clicked
Spinner value is decremented
Box value is decremented.
AgendaFromBox_Change() gets triggered and builds another AgendaBox1 & AgendaBox2
You now have 4 copies of AgendaBox1, two of them with randomly assigned names and 3 copies of AgendaBox2
Names might not be random, but they're not what you're expecting.
AgendaFromSpinner_change() continues to execute, deletes AgendaBox3
Spinner DOWN button is clicked
Spinner value is decremented
Box value is decremented.
AgendaFromBox_Change() gets triggered and builds another AgendaBox1
You now have 5 copies of AgendaBox1
AgendaFromSpinner_change() continues to execute, deletes AgendaBox2, but there's already at least one other AgendaBox2something that remains visible, so it looks like it didn't delete it.
To solve the issue, this should work:
Private Sub AgendaFromBox_Change()
Static BoxValue As Integer
if BoxValue > AgendaFromBox.Value then
'we need to update BoxValue no matter what
BoxValue = AgendaFromBox.Value
'we're decrementing the spinner - we don't need to do anything else here
Exit sub
else
'we need to update BoxValue no matter what
BoxValue = AgendaFromBox.Value
end if
If BoxValue > 10 Then
AgendaFromBox.Value = 10
Exit Sub
End If
If BoxValue = 0 Then
Exit Sub
End If
Dim NewBox As Control
Dim NewLabel As Control
Set NewBox = Me.Controls.Add("Forms.Textbox.1")
Set NewLabel = Me.Controls.Add("Forms.Label.1")
With NewBox
.Name = "AgendaBox" & boxvalue
.Top = 100 + 30 * boxvalue
.Left = 20
.Width = 100
.Height = 20
.ControlSource = "'Hidden'!C" & 2 + boxvalue
End With
With NewLabel
.Name = "AgendaLabel" & boxvalue
.Top = 100 + 30 * boxvalue
.Left = 5
.Width = 14
.Height = 20
.Caption = boxvalue & "."
End With
Worksheets("Hidden").Range("B" & 2 + i) = boxvalue
'not sure where this came from or what it does.
'I don't see it declared anywhere
NumOutBefore = BoxValue
End Sub
My guess is that you do NOT have Option Explicit declared in your module or that NumOutBefore is declared publicly at the top of the module. Make sure you have Option Explicit declared - it will save trouble later
So I am creating a tool and user guide for my client. I am attempting to integrate the user guide into Excel in the form of a Userform. My first attempt was to insert these as images of the word document, however, if the user guide is ever updated that could mean a lot of work for anyone to update the userform as well. So I was looking to see if I could have a button for the user to click that would clear the userform and recreate it dynamically any time the User Guide is updated. My issue is that when I run my code the textboxes I create which contain the text from the user guide disappear after the userform is closed.
Do I have to have a set number of textboxes or can this be dynamic in the case that the user ever adds a new section to the user guide? Can I create textboxes that stay on the userform once it is closed?
My code is below:
For i = 1 To totPara
If wrdDoc.Paragraphs(i).Style = wrdDoc.Styles("Heading 1") Or wrdDoc.Paragraphs(i).Style = wrdDoc.Styles("Heading 2") Then
headerCtr = headerCtr + 1
If headerCtr = 2 Then
labelCtr = labelCtr + 1
Set tempTxt = Nothing
Set tempTxt = userGuide.Controls.Add("Forms.TextBox.1", "Test" & labelCtr, True)
With tempTxt
.Height = 276
.Width = 288
.Top = 54
.Left = 42
.MultiLine = True
End With
tempTxt.Text = wrdDoc.Paragraphs(i).Range.Text & Chr(13)
ElseIf headerCtr > 2 Then
Exit For
End If
ElseIf labelCtr <> 0 Then
tempTxt.Text = tempTxt.Text & wrdDoc.Paragraphs(i).Range.Text & Chr(13)
End If
Next i
For right now I set it to create a new textbox only when headerCtr is equal to 2 for testing but eventually I would like to create a new textbox for each of the 9 sections.
Thank you in advance for any help.
You have the option Hide the userform instead of Close the userform. When it is hidden the textboxes can still be accessed from the calling form.
Dim frm1 As frmMainInput
Set frm1 = New frmMainInput
frm1.tbProjectNumber.Value = iProject_Number
frm1.txtDocsInUse.Text = sDocsInUse
frm1.Show
If frm1.Proceed = False Then
GoTo Local_Exit
End If
iProject_Number = CInt(frm1.tbProjectNumber.Value)
Eventually call frm.close and set frm = Nothing
In the UserForm:
Private Sub cmdCancel_Click()
Proceed = False
Me.Hide
End Sub
Private Sub cmdOK_Click()
Proceed = True
Me.Hide
End Sub
No clue about the refreshing images etc.c