I have a list box not linked to any range.
I want to click on a row and remove it. If I step through the code below, the ListBox1_Click() function ends up being called twice for some reason and the application produces an "Unspecified Error" on the second run
My entire code:
Private Sub ListBox1_Click()
ListBox1.RemoveItem (ListBox1.ListIndex)
End Sub
Private Sub UserForm_Initialize()
For i = 0 To 10
ListBox1.AddItem ("A" & Str(i))
Next i
End Sub
If you make a button about it, then this solution would be quite ok there:
Private Sub CommandButton1_Click()
Dim cnt As Long
For cnt = Me.ListBox1.ListCount - 1 To 0 Step -1
If Me.ListBox1.Selected(cnt) Then
Me.ListBox1.RemoveItem cnt
Exit Sub
End If
Next cnt
End Sub
Related
I am creating a UserForm for an Inventory Clerk who physically counts inventory for auditing purposes. The current process is on paper - I'd like to put it on a tablet.
Goal:
1) Single row comes up on form with item location, product, quantity, and description
2) If the quantity is correct, the user hits "correct" and the next item comes up
3) If the quantity is incorrect, the user keys the observed amount which gets written to column J of the corresponding data table
4) A scroll option to go forward and backward if the user wants to check/re-work an item
Private Sub CommandButton1_Click()
'GET DATA FROM TABLE
ListBox1.ColumnCount = 4
ListBox1.RowSource = "A2:D500"
End Sub
'IF QTY IS CORRECT, NEXT ROW
Private Sub CommandButton_QtyCorrect_Click()
Call SpinButton1_SpinUp
End Sub
'IF QTY DOESN'T MATCH, USER KEYS CORRECT
Private Sub CommandButton2_Click()
Range("K1") = TextBox2_Qty.Value
TextBox2_Qty.Value = ""
End Sub
Private Sub ListBox1_Click()
'DISPLAY DATA TABLE
End Sub
Private Sub SpinButton1_SpinDown()
If ListBox1.ListIndex > 0 Then
ListBox1.Selected(ListBox1.ListIndex - 1) = True
End If
End Sub
Private Sub SpinButton1_SpinUp()
If ListBox1.ListIndex + 1 < ListBox1.ListCount Then
ListBox1.Selected(ListBox1.ListIndex + 1) = True
End If
End Sub
Private Sub TextBox2_Qty_Change()
'USER OVERWRITE
End Sub
Questions:
1) With the current setup, all the rows populate the ListBox. How do I get one row at a time to display?
2) When the current row is displayed on the ListBox, how do I write to the corresponding row in column J in the case of a non-match?
Answers
1) Solved by Ralf S below.
2) Solution:
Private Sub AdjustButton_Click()
'IF QTY DOESN'T MATCH, USER KEYS CORRECT
Range("J" & SpinButton1.Value) = TextBox2_Qty.Value
TextBox2_Qty.Value = ""
End Sub
the following code would be my ansatz:
Private UserForm1_Activate()
ListBox1.ColumnCount = 4
ListBox1.RowSource = "A2:D2" ' show only first row
SpinButton1.Min = 2
SpinButton1.Max = Range("A1048576").end(xlUp).row ' last row as maximum value of spin button
End Sub
Private Sub CommandButton_QtyCorrect_Click()
If SpinButton1.Value < SpinButton1.Max Then _
SpinButton1.Value = SpinButton1.Value + 1
End Sub
Private Sub CommandButton2_Click()
Range("K1") = TextBox2_Qty.Value
TextBox2_Qty.Value = ""
End Sub
Private Sub SpinButton1_Change()
ListBox1.RowSource = "A" & SpinButton1.Value & ":D" & SpinButton1.Value
End Sub
Thus, you could use the spin button's value as the row index for your listbox.
This shows only one row at a time and it might help you out for now. But there is still a lot optimization potential...
Afternoon guys,
I cannot find a way to code the following and I do not have any code to show.
I have a small and simple userform that displays a permit expiry date based on a combo box selection using vlookup.
Screen grab of userform
What I need is to be able to change the date and write that new date back to appropriate cell in the database when hitting the command button on the left. The command button on the right just unloads the form. The form will be used to change the permit expiry date, which is required in a different database to control competition points allocation.
The code that I do have for this userform is as follows (This code is working fine):
Private Sub CmdChangedate_Click()
'This is where the code will be
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
'This is where the name is selected from a combobox and the date is located
Private Sub Hengelaar_Change()
With Me
On Error Resume Next
.Nuwepermitdatum = Application.WorksheetFunction.VLookup(CStr(Me.Hengelaar), Worksheets("Lede Lys").Range("A:J"), 10, 0)
On Error GoTo 0
End With
End Sub
Private Sub Nuwepermitdatum_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Initialize()
Dim lastrow As Integer
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Me.Nuwepermitdatum.Value = Date
Hengelaar.List = Worksheets("Lede Lys").Range("a3:a" & lastrow).Value
End Sub
Maybe this is what you’re after:
Private Sub CmdChangedate_Click()
With Worksheets("Lede Lys")
.Cells(Application.Match(Me.Hengelaar, .Range("A:A"),0), "J") = Me.Nuwepermitdatum
End With
End Sub
Purpose: Click on a cell in a range (Range: Column K:K on excel worksheet). Once you click on a specific cell in column K, userform pops up with cell value using following code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("K:K")) Is Nothing Then
Credit_Information.TextBox1.Value = Target.Value
Credit_Information.Show
End If
End Sub
My question, is depending on where I click on column K, I want to use two buttons on my userform (Previous and Next) to move up and down column K and see the values of the cell dynamically change on my userform. Is this possible? Please let me know if any clarification is needed.
Just add the two command buttons to your userform.
Name one of the buttons cmdNext and give it a caption of "Next".
Name the other button cmdPrev and give it a caption of "Previous".
Then, in the userform code module, place these routines:
Private Sub cmdNext_Click()
ActiveCell(2).Select
End Sub
Private Sub cmdPrev_Click()
If ActiveCell.Row > 1 Then ActiveCell(0).Select
End Sub
That's it.
Note: if you want you can add code to ensure that the ActiveCell is in column K before allowing the new selections:
If ActiveCell.Column = 11 Then ...
Perfect, Thanks!
I also found out that using Offset worked for me too in this manner. I'm not sure however if I'm breaking any conventions by doing this.
Private Sub CommandButton1_Click()
ActiveCell.Offset(-1).Activate
End Sub
Private Sub CommandButton2_Click()
ActiveCell.Offset(1).Activate
End Sub
It is possible, but I would create another procedure for that. What you could do is declare a public variable in your userform & set it equal to the range Target. Then you could call another procedure from the userform on each button click and redefine the selected range after each click.
So, at the top of your userform do this:
Public selected_cell as Range
Then for the up button:
Private Sub ButtonUp.Click()
If selected_cell.Row < 2 Then Exit Sub
selected_cell.Rows(0).Select
Set selected_cell = selected_cell.Rows(0)
me.TextBox1.Value = selected_cell
End Sub
And the down button would be:
Private Sub ButtonDown.Click()
selected_cell.Rows(2).Select
Set selected_cell = selected_cell.Rows(2)
me.TextBox1.Value = selected_cell
End Sub
Now let's make your code like this:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("K:K")) Is Nothing Then
With Credit_Information
Set .selected_cell = target
.TextBox1.Value = Target.Value
.Show
End With
End If
End Sub
I wrote the code below to delete control in another VB.NET Form; that workd fine; But the code cannot Detect that the Form has NO Controls; What is wrong with the code please:
Sub DeleteControls() ' WORKING
For i As Integer = Form2.Controls.Count - 1 To 0 Step -1
Dim ctrl = Form2.Controls(i)
ctrl.Dispose()
Next
End Sub
Sub TestForm() ' NOT WORKING
If Form2.Controls Is Nothing Then
MessageBox.Show("Form2 has No Controls")
End If
End Sub
Thanks
First you need to count the controls on form 2."
Dim GetControls As Integer = Form2.Controls.Count"
Then Check if GetControls is smaller then 1 "No controls"
Sub TestForm()
Dim GetControls As Integer = Form2.Controls.Count
If GetControls < 1 Then
MessageBox.Show("Form2 has No Controls")
End If
End Sub
I have three different Subs available in a VBA module and wanted to call those series of Subs from an unique Sub activated through a VBA button.
Below the code running:
Sub Updateworkbook()
Call Unprotectworkbook
Call CopyAndPaste
Call Protectworkbook
End Sub
After the first Sub Unprotectworkbook() is run the other Sub are not called and executed. Why this happens?
Below the Unprotectworkbook() Sub code for your reference
Sub Unprotectworkbook()
Dim myCount
Dim i
myCount = Application.Sheets.Count
Sheets(1).Select
For i = 1 To myCount
ActiveSheet.Unprotect "password"
If i = myCount Then
End
End If
ActiveSheet.Next.Select
Next i
End Sub
Modify your code as follows (change End to Exit Sub):
Sub Unprotectworkbook()
Dim myCount
Dim i
myCount = Application.Sheets.Count
Sheets(1).Select
For i = 1 To myCount
ActiveSheet.Unprotect "password"
If i = myCount Then
Exit Sub
End If
ActiveSheet.Next.Select
Next i
End Sub
or you can simply change it to the next one:
Sub Unprotectworkbook()
Dim sh
For Each sh In Sheets
sh.Unprotect "password"
Next
End Sub
It is very hard to answer your question without seeing the code in all three subs.
Some pointers though:
You don't need to select each sheet in order to modify it - just use Sheet(i).Unprotect "password" in the for loop instead.
Also, since you have a for loop you don't need to code when it should end, if you have defined the For i = 1 To myCount statement correctly. In other words, remove the If i = myCount Then End part.
You could define the For loop like the following: For i = 1 To Application.Sheets.Count to simplify your code, then you can remove the myCount variable.
You should always define your variables with a datatype in order to minimize errors, e.g use Dim i As Integer instead.
Always use Option Explicit at the top of each module, also to minimize confusion and errors caused by typos etc.
I strongly advise you to run through a couple of tutorials on VBA, there are lots around. The following is just the first one up when searching, I haven't tried it: Excel VBA Basic Tutorial 1
If this helps, I recommend making another set of 3 subs to test blank items first. Otherwise use one of the other answers above.
Sub msgTEST0() 'Call msgTEST0
Call msgTEST1
Call msgTEST2
Call msgTEST3
End Sub
Sub msgTEST1()
MsgBox "MSG1" & Space(10), vbQuestion
End Sub
Sub msgTEST2()
MsgBox "MSG2" & Space(10), vbQuestion
End Sub
Sub msgTEST3()
MsgBox "MSG3" & Space(10), vbQuestion
End Sub