I am working on a customer complaint database. I want to implement a userform for data entry.
I have a button to clear the userform. It clears the entire form except for ComboBox2 that has results which are dependent on the selection from ComboBox1.
I get a 1004 run-time error based which calls back to the Match function I've used for ComboBox2.
Private Sub CommandButton2_Click()
Clear_Form
End Sub
Sub Clear_Form()
Me.ComboBox2.Clear
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox"
ctl.Text = ""
Case "ComboBox"
ctl.ListIndex = -1
End Select
Next ctl
End Sub
Private Sub UserForm_Activate()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Customer")
Dim i As Integer
Me.ComboBox1.Clear
For i = 1 To Application.WorksheetFunction.CountA(sh.Range("1:1"))
Me.ComboBox1.AddItem sh.Cells(1, i).Value
Next i
End Sub
Private Sub ComboBox1_Change()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Customer")
Dim i As Integer
Dim n As Integer
n = Application.WorksheetFunction.Match(Me.ComboBox1.Value, sh.Range("1:1"), 0)
Me.ComboBox2.Clear
For i = 2 To Application.WorksheetFunction.CountA(sh.Cells(1, n).EntireColumn)
Me.ComboBox2.AddItem sh.Cells(i, n).Value
Next i
End Sub
You will get an error because Clear_Form clears the combobox which in turn calls the _Change event and the Match fails because there is no value in combobox. Simply add one line to the _Change event.
Private Sub ComboBox1_Change()
If ComboBox1.ListIndex = -1 Then Exit Sub '<~~ ADD THIS
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Customer")
Dim i As Integer
Dim n As Integer
n = Application.WorksheetFunction.Match(Me.ComboBox1.Value, sh.Range("1:1"), 0)
Me.ComboBox2.Clear
For i = 2 To Application.WorksheetFunction.CountA(sh.Cells(1, n).EntireColumn)
Me.ComboBox2.AddItem sh.Cells(i, n).Value
Next i
End Sub
Related
I'm putting together a spreadsheet that should populate checkboxes in a specific column when the spreadsheet opens if the appropriate A Column/Row is not empty. It should also remove checkboxes when it finds that same A column to be empty. My VB is correctly creating the checkboxes, but I cannot figure out how to tell the code to delete the checkbox from a specific cell.
Most articles I find mention removed ALL checkboxes, but I'm looking to do it conditionally. Any guidance would be greatly appreciated.
Private Sub Workbook_Open()
'declare a variable
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
'calculate if a cell is not blank across a range of cells with a For Loop
For x = 2 To 1000
If ws.Cells(x, 1) <> "" Then
Call Add_CheckBox(CInt(x))
Else
Call Delete_CheckBox(CInt(x))
End If
Next x
End Sub
Private Sub Add_CheckBox(Row As Integer)
ActiveSheet.CheckBoxes.Add(Cells(Row, "T").Left, Cells(Row, "T").Top, 72, 12.75).Select
With Selection
.Caption = ""
.Value = xlOff '
.LinkedCell = "AA" & Row
.Display3DShading = False
End With
End Sub
Private Sub Delete_CheckBox(Row As Integer)
Dim cb As CheckBox
If cb.TopLeftCell.Address = (Row, "T") Then cb.Delete
End Sub
Naming the CheckBoxes will make it easier to maintain your code.
Private Sub Workbook_Open()
Const CheckBoxPrefix As String = "Sheet1TColumnCheckBox"
'declare a variable
Dim CheckBoxName As String
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
'calculate if a cell is not blank across a range of cells with a For Loop
Dim r As Long
For r = 2 To 1000
CheckBoxName = CheckBoxPrefix & r
If Len(ws.Cells(r, 1)) > 0 Then
If Not WorksheetContainsCheckBox(CheckBoxName, ws) Then Add_CheckBox CheckBoxName, ws.Cells(r, 1), ws.Cells(r, "AA")
Else
If WorksheetContainsCheckBox(CheckBoxName, ws) Then ws.CheckBoxes(CheckBoxName).Delete
End If
Next
End Sub
Private Sub Add_CheckBox(CheckBoxName As String, Cell As Range, LinkedCell As Range)
With Cell.Worksheet.CheckBoxes.Add(Cell.Left, Cell.Top, 72, 12.75)
.Caption = ""
.Value = xlOff '
.LinkedCell = LinkedCell
.Display3DShading = False
.Name = CheckBoxName
End With
End Sub
Function WorksheetContainsCheckBox(CheckBoxName As String, ws As Worksheet)
Dim CheckBox As Object
On Error Resume Next
Set CheckBox = ws.CheckBoxes(CheckBoxName)
WorksheetContainsCheckBox = Err.Number = 0
On Error GoTo 0
End Function
Try something like this (put a checkbox "in" A1 but not C1)
Sub tester()
Debug.Print Delete_CheckBox([A1])
Debug.Print Delete_CheckBox([C1])
End Sub
'Return True if able to delete a checkbox from range `rng`
Private Function Delete_CheckBox(rng As Range) As Boolean
Dim cb As CheckBox
For Each cb In rng.Worksheet.CheckBoxes
If Not Application.Intersect(cb.TopLeftCell, rng) Is Nothing Then
Debug.Print "Deleting checkbox in " & cb.TopLeftCell.Address
cb.Delete
Delete_CheckBox = True
Exit For 'if only expecting one matched checkbox
End If
Next cb
End Function
I am trying to have a UserForm GUI so that we can add and subtract from inventory, I have got it so that I can select a worksheet and a row, but I am having trouble adding and subtracting part. Pretty new to VBA and I am not sure how to call that variable and modify it. Any help would be great!! Here is my code in the UserForm:
Option Explicit
Private Sub BTNadd_Click()
End Sub
Private Sub BTNDone_Click()
'This will save and close the GUI'
ThisWorkbook.Save
StgRmGUI.Hide
End Sub
Private Sub BTNrmv_Click()
End Sub
Private Sub ItmNmSlct_Change()
Dim actItm As String
End Sub
Private Sub ItmTypSlct_Change()
'This allows ItmTypSlct to show available wrkshts then will make item show in Item Name box'
With Worksheets(ItmTypSlct.Value)
ItmNmSlct.RowSource = Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Address(, , , True)
End With
End Sub
Private Sub NumBox_Change()
Dim NewVal As Integer
NewVal = Val(NumBox.Text)
If NewVal >= SpBtnARNum.Min And _
NewVal <= SpBtnARNum.Max Then _
SpBtnARNum.Value = NewVal
End Sub
Private Sub SpBtnARNum_Change()
NumBox.Text = SpBtnARNum.Value
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Initialize()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = xlSheetVisible Then
ItmTypSlct.AddItem ws.Name
End If
Next ws
End Sub
An simple example of updating the column B value by the amount in NumBox
Private Sub BTNadd_Click()
Dim r As Long, cell As Range
With ItmNmSlct
r = .ListIndex
If r < 0 Then Exit Sub
' select quatity cell and increment value
Set cell = Range(.RowSource).Cells(r + 1, 2)
cell.Value = cell.Value + NumBox.Value
End With
End Sub
Can anyone help me with a solution or a different method for this? I would like to edit the filtered listbox
I'm trying to get a listbox that is able to display my sheet1 and be able to filter all the blanks/not found in column A. I also want to be able to edit the listbox aswell
I would like my userform2 listbox to display the sheet1 information.
There will also be a checkbox which will filter the listbox to show “not found” or blank lines.
If i double click the selected item on the listbox i would like to edit the information
for userform2
Private Sub ListBox2_Click()
TextBox1.Enabled = True
TextBox1.Value = ListBox2.Value
End Sub
Private Sub TextBox1_Change()
Dim rCell As Range
With ListBox2
Set rCell = Range(.RowSource).Resize(1).Offset(.ListIndex)
rCell.Value = TextBox1.Value
End With
End Sub
Private Sub CheckBox1_Click()
OptimizedMode True
If userform2.CheckBox1.Value = True Then
Worksheets("Table").Range("A1").AutoFilter Field:=1, Criteria1:="Not Found", Operator:=xlOr, Criteria2:="="
userform2.ListBox2.RowSource = vbNullString
userform2.ListBox2.ColumnHeads = False
Dim rng As Range
Dim Cel1 As Range
Dim LR As Long
Dim ws As Worksheet
Set ws = Sheets("Table")
With ws
LR = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A2:A" & LR).SpecialCells(xlCellTypeVisible)
With userform2.ListBox2
.ColumnCount = 1
For Each Cel1 In rng
.AddItem CStr(Cel1.Value)
.List(.ListCount - 1, 1) = Cel1.Offset(0, 1).Value
Next Cel1
End With
End With
End If
If CheckBox1.Value = False Then
With userform2.ListBox2
.RowSource = "Table!A2:A1048576"
End With
End If
OptimizedMode False
End Sub
I've re-designed my code and I believe this will achieve what you are after.
NOTE: This code uses all default object names. You will need to modify it to target the names for your workbook, sheet, useform, controls etc, if you wish to implement into your project.
In designing this answer I used the following:
A new blank Workbook with 1 new Worksheet
A new UserForm (captioned "ListBox Editor") with 1 ListBox that has 2 columns (ColumnCount = 2) and 1 CheckBox (captioned "Show Blanks").
The sample data I used was in Range("A1:A10") filling only odd numbers from row 1. This allows testing for including/excluding blank/empty rows. Screenshots of the Worksheet and UserForm below.
Worksheet data:
UserForms both with and without blanks in the listbox:
All code is written in the code behind module for the UserForm
Most can be written into any other module with calls made to the subs/functions from the UserForm/ListBox events if you'd prefer not to have the working code in the UserForm module.
Code blocks with explanations below (full code block at the end for copy/paste):
Option Explicit
Option Explicit should be included at the top of each and every code module you use. It forces explicit declaration of all variables which helps significantly in avoiding typo's in your code etc.
Private Sub PopulateListBox(ByVal IncludeBlanks As Boolean)
Dim TargetCell As Range
Dim TargetWorksheet As Worksheet
Set TargetWorksheet = ThisWorkbook.Sheets("Sheet1")
With UserForm1.ListBox1
.Clear
For Each TargetCell In TargetWorksheet.Range("A1:A10")
If Not IncludeBlanks Then
If Not TargetCell.Value = "" Then
.AddItem TargetCell.Value
.List(.ListCount - 1, 1) = TargetCell.Row
End If
ElseIf IncludeBlanks Then
.AddItem TargetCell.Value
.List(.ListCount - 1, 1) = TargetCell.Row
End If
Next TargetCell
.ColumnWidths = ";0" 'Hides listbox column that holds row number
End With
End Sub
PopulateListBox is a subroutine I wrote to handle population of the items in the ListBox. It first clears the list, allowing each population of the listbox to be 'refreshed' data. Then it iterates through each TargetCell of the defined Range. If IncludeBlanks is True it has no conditions to meet and adds each cell value into the list, if IncludeBlanks is False it will only add the cell value to the list if the value is not "".
Private Sub CheckBox1_Click()
If Me.CheckBox1.Value = False Then
PopulateListBox False
ElseIf Me.CheckBox1.Value = True Then
PopulateListBox True
End If
End Sub
This _Click event simply updates the ListBox list based on if the CheckBox is checked or not. The CheckBox represents if you are including blanks/empty cells or not so it passes True or False respective to it's Value, to the IncludeBlanks argument in PopulateListBox.
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim NewValue As Variant
Dim TargetWorksheet As Worksheet
Set TargetWorksheet = ThisWorkbook.Sheets("Sheet1")
NewValue = InputBox("What is the new value to replace " & UserForm1.ListBox1 & "?")
If Not StrPtr(NewValue) = 0 Then 'Check user did NOT click cancel or [X]
With ListBox1
If NewValue = "" Then NewValue = vbNullString
TargetWorksheet.Cells(.List(.ListIndex, 1), 1).Value = NewValue
.AddItem NewValue, .ListIndex
.RemoveItem .ListIndex
End With
End If
End Sub
The _DblClick Event triggers the code when a list item is double clicked. This code first opens an InputBox to allow the user to enter a new value for the selected listbox item. When the user clicks OK or hit's Enter, the new value is first written to the Cell that the original value came from, then the new value is added as a new list item and finally the previous value is removed. If the user clicks [X] or 'Cancel' the code does nothing.
Private Sub UserForm_Initialize()
PopulateListBox False
End Sub
Much the same as the Checkbox_Change code, this simply populates the ListBox when the UserForm is first initialized. It's written to exclude blanks, specified by False for the IncludeBlanks argument.
Put it all together and you have:
Option Explicit
Private Sub CheckBox1_Click()
If Me.CheckBox1.Value = False Then
PopulateListBox False
ElseIf Me.CheckBox1.Value = True Then
PopulateListBox True
End If
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim NewValue As Variant
Dim TargetWorksheet As Worksheet
Set TargetWorksheet = ThisWorkbook.Sheets("Sheet1")
NewValue = InputBox("What is the new value to replace " & UserForm1.ListBox1 & "?")
If Not StrPtr(NewValue) = 0 Then 'Check user did NOT click cancel or [X]
With ListBox1
If NewValue = "" Then NewValue = vbNullString
TargetWorksheet.Cells(.List(.ListIndex, 1), 1).Value = NewValue
.AddItem NewValue, .ListIndex
.RemoveItem .ListIndex
End With
End If
End Sub
Private Sub UserForm_Initialize()
PopulateListBox False
End Sub
Private Sub PopulateListBox(ByVal IncludeBlanks As Boolean)
Dim TargetCell As Range
Dim TargetWorksheet As Worksheet
Set TargetWorksheet = ThisWorkbook.Sheets("Sheet1")
With UserForm1.ListBox1
.Clear
For Each TargetCell In Range("A1:A10")
If Not IncludeBlanks Then
If Not TargetCell.Value = "" Then
.AddItem TargetCell.Value
.List(.ListCount - 1, 1) = TargetCell.Row
End If
ElseIf IncludeBlanks Then
.AddItem TargetCell.Value
.List(.ListCount - 1, 1) = TargetCell.Row
End If
Next TargetCell
.ColumnWidths = ";0"
End With
End Sub
I have a combobox with options from 300 to 650 with increment of 10 and I need another combobox to display options -5 of previous value and -15 of previous value so in case the first combobox selection is 300 then the other combobox displays options 295 and 285. I know it's possible to manually write down all the options for all the cases but it would be insane. I wonder if someone has a simple solution for this?
Private Sub UserForm_Initialize()
ComboBox1.AddItem "300"
ComboBox1.AddItem "310"
ComboBox1.AddItem "320"
End Sub
Private Sub ComboBox1_Change()
Application.EnableEvents = False
ComboBox2.Clear
Application.EnableEvents = True
Select Case ComboBox1.Value
Case "300"
ComboBox2.AddItem "295"
ComboBox2.AddItem "285"
End Select
End Sub
Fill Combo Boxes
For fast loading data to a combo or a list box, it is recommended to use the List property with an array of values.
The Code
Option Explicit
Private Sub UserForm_Initialize()
Const nMin As Long = 300
Const nMax As Long = 650
Const nInc As Long = 10
Dim n As Long: n = Int((nMax - nMin) / nInc)
Dim arr() As Long: ReDim arr(0 To Int((nMax - nMin) / nInc))
Dim nCurr As Long: nCurr = nMin
Dim i As Long
For i = 0 To n
arr(i) = nCurr
nCurr = nCurr + nInc
Next i
ComboBox1.List = arr
End Sub
Private Sub ComboBox1_Change()
With ComboBox2
.Clear
.AddItem ComboBox1.Value - 5
.AddItem ComboBox1.Value - 15
End With
End Sub
Use simple math:
Private Sub UserForm_Initialize()
Dim i As Long
ComboBox1.Clear
For i = 300 To 650 Step 10
ComboBox1.AddItem CStr(i)
Next
End Sub
Private Sub ComboBox1_Change()
Application.EnableEvents = False
ComboBox2.Clear
Application.EnableEvents = True
Dim cb1Val
cb1Val = val(ComboBox1.Value)
If cb1Val > 0 Then
ComboBox2.AddItem CStr(cb1Val - 5)
ComboBox2.AddItem CStr(cb1Val - 15)
End If
End Sub
THIS IS AN UPDATE TO MY ORIGINAL QUESTION OF 12/5. IT INCLUDES THE COMPLETE CODE USED FOR THE WORKBOOK.
MANY, MANY THANKS.!!!
I created a form that has 3 text boxes for data entry. It also has 3 buttons to choose from after data entry. The below code populates the table with the information from the form plus some additional information from the header in the worksheet when an "Update" button is pressed. This worked fine until I entered the code line " Reg1.SetFocus". I did this to set the focus back to the first text box after pressing the update button. I now get "Run-Time error 13" that debugs to this line of code:
".Reg4 = Application.WorksheetFunction.VLookup(CLng(Me.Reg1), Sheet2.Range("Lookup"), 4, 0)"
This all goes away if I delete the "Reg1.SetFocus" line in the prior sub.
The complete code for the workbook is:
Option Explicit
'Private Sub AmountEntry_Exit(ByVal Cancel As MSForms.ReturnBoolean)
AmountEntry.Value = Format(AmountEntry.Value, "$#,#00.00")
End Sub
Private Sub AmountEntry_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
End Sub
Private Sub ClearButton_Click()
Dim Ctrl As MSForms.Control
F or Each Ctrl In Input_Form.Controls
Select Case TypeName(Ctrl)
Case "TextBox"
Ctrl.Text = ""
Case "OptionButton"
Ctrl.Value = False
Case "ComboBox"
Ctrl.ListIndex = -1
End Select
Next Ctrl
'DateSelect.Value = Date
End Sub
Private Sub CloseButton_Click()
Unload Input_Form
End Sub
Private Sub UpdateTableButton_Click()
Dim LastRow As Range
Dim AssistanceTable As ListObject
'Add row to bottom of Assistance table
ActiveSheet.ListObjects("Assistance").ListRows.Add
'Enter data from form into our new row
Set AssistanceTable = ActiveSheet.ListObjects("Assistance")
Set LastRow = AssistanceTable.ListRows(AssistanceTable.ListRows.Count).Range
With LastRow
.Cells(1, 1) = Range("fund").Value
.Cells(1, 2) = Reg1.Value
.Cells(1, 3) = Reg2.Value
.Cells(1, 4) = Range("mass_date").Value
.Cells(1, 5) = Reg3.Value
.Cells(1, 6) = Range("mass_time").Value
End With
Dim Ctrl As MSForms.Control
For Each Ctrl In Input_Form.Controls
Select Case TypeName(Ctrl)
Case "TextBox"
Ctrl.Text = ""
Case "OptionButton"
Ctrl.Value = False
Case "ComboBox"
Ctrl.ListIndex = -1
End Select
'Set focus to Parishioner ID
On Error Resume Next
Reg1.SetFocus
On Error GoTo 0
Next Ctrl
End Sub
Private Sub UpdateTableButton_Enter()
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub Reg1_AfterUpdate()
'Check to see if value exists
If WorksheetFunction.CountIf(Sheet2.Range("a:a"), Me.Reg1.Value) = 0 Then
MsgBox "Parishioner not yet in database"
Me.Reg1.Value = ""
Exit Sub
End If
'Lookup values based on first control
With Me.Reg4 = Application.WorksheetFunction.VLookup(CLng(Me.Reg1), Sheet2.Range("Lookup"), 4, 0)
End With
End Sub
Private Sub ComboBox2_Change()
Range("b3").Value = Format(Me.ComboBox2.Value, "dd mmm,yyyy")
End Sub
Private Sub UserForm_Initialize()
Me.Reg3.AddItem "Check"
Me.Reg3.AddItem "Cash"
End Sub