I have a user form where they should pick a supplier from a table in the worksheet and when they press the "ShowProducts" command, the form should show all the articles from this supplier in the textbox below.
I made the following code but it keeps giving me an error on the line If Suppl.Value = Me.LstB_Supplier.Value Then.
I have searched and tried different options I have found on this and other sites, but I can't seem to find what it wrong.
Can anyone help me out? Thanks!
Private Sub Cmd_ShowProducts_Click()
Dim Suppl As Range
Dim i As Integer
For Each Suppl In Range("T_Prod_Fix[Supplier Name]")
If Suppl.Value = Me.LstB_Supplier.Value Then
With Me.LstB_Products
.AddItem
.List(i, 0) = Suppl.Offset(0, 1).Value 'article nbr
.List(i, 1) = Suppl.Offset(0, -1).Value 'article name
i = i + 1
End With
End If
Next Suppl
End Sub
If you need to check, whether a value, selected in a list box is present in another list, you need a nested loop. With the first loop you get the selected value and with the inner loop you need to check whether it exists in your range.
E.g. in your case:
For lItem = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lItem) Then 'Check for selection
For Each suppl In Range("T_Prod_Fix[Supplier Name]")
If suppl = ListBox1(lItem) Then
'your logic
End If
Next suppl
End If
Next lItem
Related: VBA to get values from a listbox on a spreadsheet in Excel
Related
I'm trying to link a user form I built in VBA editor for MS Excel 2010 to the data in an excel worksheet, but I'm getting a
run-time error 424: Object required.
I referred to the active worksheet explicitly in my code to try and remedy this, but it still comes up with the same error. My code is:
Private Sub GetData()
Dim r As Long
r = ActiveSheet.Range("B2").Value
If IsNumeric(RowNumber.Text) Then
r = CLng(RowNumber.Text)
Else
ClearData
MsgBox "Invalid row number"
Exit Sub
End If
If r > 1 And r <= LastRow Then
cboFilterResultId.Text = FormatNumber(Cells(r, 1), 0)
txtFolderPaths.Text = Cells(r, 2)
txtFileName.Text = Cells(r, 3)
txtDeletedDate.Text = Cells(r, 4)
txtReason.Text = Cells(r, 5)
txtcboAdd.Text = Cells(r, 6)
txtcboView.Text = Cells(r, 7)
txtcboChange.Text = Cells(r, 8)
DisableSave
ElseIf r = 1 Then
ClearData
Else
ClearData
MsgBox "Invalid row number"
End If
End Sub
Where RowNumber is a textbox where the user can enter the row number for the data they want.
Please help!
I rarely use ActiveSheet just in case that isn't the sheet I'm after. Generally better to be explicit which sheet you're referring to:
r=ThisWorkbook.WorkSheets("Sheet1").Range("B2")
Right, pulling data from a worksheet to a userform... as you haven't said which line your error occurs on and you haven't given us the code for ClearData or DisableSave I'll start from scratch.
Example Form Design
I create a blank userform and add three text boxes and a spin button to it:
txtRowNumber holds the row number that the data is pulled from.
TextBox1 and TextBox2 will hold my sample values.
In the Tag property of TextBox1 I enter 1 and in the Tag property of TextBox2 I enter 2. These are the column numbers that the data will be pulled from.
In reality I usually add extra stuff, for example, 8;CPER;REQD. I'd then use some code to pull it apart so it pastes in column 8, must have a percentage and is a required entry.
spnButton is used to quickly move up or down a row.
We'll need two procedures to populate the form from the given row number and to clear all controls on the form (ready for the next row to be brought in).
Any textbox or combobox that has something in it's Tag property is cleared:
Private Sub ClearForm()
Dim frmCtrl As Control
For Each frmCtrl In Me.Controls
If frmCtrl.Tag <> "" Then
Select Case TypeName(frmCtrl)
Case "TextBox", "ComboBox"
frmCtrl.Value = Null
Case Else
'Do nothing.
End Select
End If
Next frmCtrl
End Sub
Any control that has a Tag value (it's assumed the value is correct) is populated from the specified RowNumber and column (from the Tag value). The value is always taken from the sheet called MyDataSheet in the workbook containing the VBA code (ThisWorkbook) no matter which is currently active:
Private Sub PopulateForm(RowNumber As Long)
Dim frmCtrl As Control
For Each frmCtrl In Me.Controls
With frmCtrl
If .Tag <> "" Then
.Value = ThisWorkbook.Worksheets("MyDataSheet").Cells(RowNumber, CLng(.Tag))
End If
End With
Next frmCtrl
End Sub
Whenever txtRowNumber changes the form should update with values from the indicated row. To do this we'll need to clear the form of current data and then repopulate it:
Private Sub txtRowNumber_Change()
ClearForm
PopulateForm CLng(Me.txtRowNumber)
End Sub
The spin button should increase/decrease the value in .txtRowNumber. I've added checks that it doesn't go below 1. You should also add checks that it doesn't go higher than the last populated row.
Private Sub spnButton_SpinDown()
With Me
.txtRowNumber = CLng(.txtRowNumber) + 1
End With
End Sub
Private Sub spnButton_SpinUp()
With Me
If CLng(.txtRowNumber) > 1 Then
.txtRowNumber = CLng(.txtRowNumber) - 1
End If
End With
End Sub
Finally, the form should be populated when it is first opened:
Private Sub UserForm_Initialize()
With Me
.txtRowNumber = 2
.spnButton = .txtRowNumber
PopulateForm .txtRowNumber
End With
End Sub
guys I hope someone can help me with this one.
I have a combo box that has data from a named range and I would like to select a value from the combo box and add it to the list box.
Currently I can add an item into the list box with a button but once I add another it overwrites the current item.
Also It needs to be able to add an item at the bottom if the list box already has some values in it.
I think it has something to do with finding the last row but I'm not sure, any help would be highly appreciated :)
image of the issue
Dim i As Integer
With Me.lb_lease
.ColumnCount = 3
.ColumnWidths = "200;50;50"
.AddItem
.List(i, 0) = cbox_hardware.Column(0)
.List(i, 1) = cbox_hardware.Column(1)
.List(i, 2) = cbox_hardware.Column(2)
i = i + 1
End With
I suggest to separate the actions of setting up the listbox and adding items to it. The procedure below will set up the box and clear all existing content. Change the names of the worksheet and the Listbox to match your circumstances. The code will also work if the listbox is in a userform.
Private Sub ResetListBox()
With Worksheets("LibraryAccount").ListBox1
.ColumnCount = 3
.ColumnWidths = "80;50;50"
.Clear ' delete current list
End With
End Sub
The next procedure adds an item to it. It requires a semi-colon separated string, like "One;Two;Three". You might concatenate it from your combobox result using ListIndex to identify the row. The procedure will disassemble the string and add it at the bottom of the list. Worksheet and ListBox names must be changed.
Private Sub AddToListBox(AddArray As String)
Dim Arr() As String
Dim i As Integer
Dim C As Long
Arr = Split(AddArray, ";")
With Worksheets("LibraryAccount").ListBox1
i = .ListCount
.AddItem
For C = 0 To 2
.List(i, C) = Arr(C)
Next C
End With
End Sub
The procedure below is for testing the above procedure. You can run ResetListbox and then call TestAdd several times.
Private Sub TestAdd()
AddToListBox "One;Two;Three"
End Sub
I am working on simple excel application for multiple users who will enter the data during different stages of the process. Unfortunately I met the problems with storage the data from multiple userforms in one row of the table.
I will try to explain what is the whole thing about as clear as I can.
For example purposes I called the application "Movie Time Control". Let's imagine that it is a tool for controlling the movies watched with focus on:
when the movie started,
if there were some breaks during displaying (and why)
when the movie has been restarted (how long the break took, and how many breaks there were and what actions were taken to continue),
in case when the movie was aborted, when, and why?
when the movie ended.
The MENU of application segment will look as on the screenshot below:
For each button different userform is assigned. The data entered in each form should be stored in one row in specific sheet.
Functionality of the userforms:
MOVIE START: Creating the entry in the table with movie title, date and time when its started.
MOVIE BREAK: Based on the movie title previously defined, filling out the date and time, reason of break (from the drop-down list or text box if not standard). The function can be used up to three times (three breaks).
MOVIE RESTART: If the break occurred, filling out the information about the date, time when movie was restarted, and what action has been taken in order to deal with the previously defined reason of break. For each break (possible three) function can be used.
MOVIE ABORT When (date and time) movie has been aborted (without intention to continue).
MOVIE FINISHED When (date and time) movie ended.
Where the problems occurred (questions):
When the data from the first row are entered, the entry with the specific title is created in the table separate sheet. Based on this entry, Title Combobox in all other userforms should list the titles which were started but not finished or aborted - just to quickly choose the "open title" and fill out other information related to the title. How to create a macro to list the "open cases" in the combobox?
I couldn't find out how to transfer the rest of the data to the same row of the table but different columns from all the forms after creating the entry with the specific movie title. Important thing is that the data can be added only to row with corresponding title (chosen from combobox from first question). Could you help me with the macro?
Macros I created until now (I am very beginner with VBA, thanks for understanding):
MOVIE START: For creating the entry with movie title.
Private Sub movie_start_save_Click()
If MsgBox("ARE YOU SURE?", vbYesNo, "Please confirm") = vbYes Then
Dim emptyRow As Long
'Make Sheet2 active
Sheet2.Activate
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Transfer information
Cells(emptyRow, 1).Value = Movie_Title_Box.Value
Cells(emptyRow, 2).Value = Start_Date_Box.Value
Cells(emptyRow, 3).Value = Start_Time_Box.Value
'Closing the form
Unload Me
'Back to MENU
Sheet1.Select
End If
End Sub
Private Sub movie_start_cancel_Click()
Unload Me
End Sub
MOVIE BREAK: For defining the time and reason (cannot transfer the data):
Private Sub UserForm_Initialize()
'Fill ReasonComboBox
With ReasonComboBox
.AddItem "Tea"
.AddItem "Coffee"
.AddItem "Popcorn"
.AddItem "Dinner"
.AddItem "Not standard"
End With
'Default text in the reason box
ReasonTextBox.ForeColor = &HC0C0C0 '<~~ Grey Color
ReasonTextBox.Text = "In case of 'not standard' reason leave your comment here"
movie_break_cancel.SetFocus '<~~ This is required so that the focus moves from TB
End Sub
'Default text in the reason box - disapearing when you want to edit
Private Sub ReasonTextBox_Enter()
With ReasonTextBox
If .Text = "In case of 'not standard' reason leave your comment here" Then
.ForeColor = &H80000008 '<~ Black Color
.Text = ""
End If
End With
End Sub
'Default text in the reason box - somehow disappearing for good, but ok
Private Sub ReasonTextBox_AfterUpdate()
With ReasonTextBox
If .Text = "" Then
.ForeColor = &H80000008
.Text = ""
End If
End With
End Sub
'Cancel Button
Private Sub movie_break_cancel_Click()
Unload Me
End Sub
The rest is actually similar with a few differences.
Link to download the excel file:
https://drive.google.com/file/d/0BxFSL2h-9qflQjRzNTQ2ZlhJNjA/view?usp=sharing
Hopefully I expressed myself clear enough to understand this.
Greetings!
In my example below, I show how to configure a ComboBox to hold multiple columns of data and to later retrieve the values. This will allow you to store the Row number along with the movie data in the ComboBox.
'Filtering for not finished jobs for combobox
Private Sub UserForm_Initialize()
Dim ws As Worksheet
Dim x As Long
With Me.Movie_Title_ComboBox
.ColumnCount = 4
.ColumnWidths = "0 pt;250 pt;90 pt; 90 pt;"
'.ListWidth = 500
.TextColumn = 2
.BoundColumn = 1
End With
Set ws = Sheet2
With ws
For x = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
If .Cells(x, 4).Value = "" Then
AddItems Me.Movie_Title_ComboBox, x, .Cells(x, 1).Value, Format(.Cells(x, 3).Value, "MM/DD/YYYY"), Format(.Cells(x, 3).Value, "HH:MM")
End If
Next
End With
End Sub
Private Sub Movie_Title_ComboBox_Change()
With Me.Movie_Title_ComboBox
If .ListIndex > -1 Then
Finish_Date_Box.Value = .List(.ListIndex, 2)
End If
End With
End Sub
Private Sub movie_finished_save_Click()
With Sheet2
.Cells(Me.Movie_Title_ComboBox.Value, 4) = Me.Finish_Date_Box.Value
.Cells(Me.Movie_Title_ComboBox.Value, 5) = Me.Start_Time_Box.Value
End With
End Sub
Add this function to a Public Code Module so that it will be available to all your userforms.
Sub AddItems(oComboBox As MSForms.ComboBox, ParamArray Items() As Variant)
Dim x As Long
With oComboBox
.AddItem Items(0)
For x = 1 To UBound(Items)
.List(.ListCount - 1, x) = Items(x)
Next
End With
End Sub
I am developing an application, in excel with VBA forms. in one form I have a combobox to that let user select customer name, the rowsource of this combobox is a named range (name column of customers table). Everything working fine but I need to add 1 or more additional items in the combobox that not exist in the table column. For example I need to add "All" item in the cobmobox so user can select a particular customer name or All. at other place I wan't to add "Other" item in combobox with same rowsource so if the customer is new user can select Other and then type name in textbox.
I tried following code to add an item
Private Sub UserForm_Activate()
With Me.testCombo
.AddItem "All"
End With
End Sub
but i got error
Run-time error '70'
permission denied
if i remove rowsource property from the combobox then the above code work but only one item "All" display.
Note: I don't want to add "All" and "Other" in customer table, this could be easy solution but will cause other problem.
Try like this:
Private Sub UserForm_Activate()
Dim rowValue As Variant
Dim lngCount As Long
Dim myCell As Range
Dim varCombo() As Variant
With Me.ComboBox1
ReDim varCombo(Me.ComboBox1.ListCount)
For Each myCell In Range(.RowSource)
varCombo(lngCount) = myCell.value
lngCount = lngCount + 1
Next myCell
.RowSource = ""
For lngCount = LBound(varCombo) To UBound(varCombo) - 1
.AddItem CStr(varCombo(lngCount))
Next lngCount
.AddItem "All"
.AddItem "Nothing"
End With
End Sub
As mentioned in the comments, by A.S.H., you should unset the .RowSource property. However, you do not lose it, if you run the code twice, it would be the same. In my code I use UBound(varCombo) - 1, because I use lngCount=lngCount+1 on the last looping over the cell.
Something like this could do what you need
Dim a() As Variant
Dim b() As String
Dim s As String
a = Application.Transpose(Range("a1:a5").Value)
s = "Please select;" & Join(a, ";")
Erase a
b = Split(s, ";")
Me.ComboBox1.List = b
Thank you everyone for helping, the main problem was permission as A.S.H said if Rowsource is set then cannot add any item in the ComboBox. So I delete the RowSource from the properties in form. and wrote following code and it seems everything working fine. I hope my codes are good enough and simple.
Private Sub fillComboBox()
Dim comboData As Range
With Me.CWR_CustName
' first option of comobobox will be All
.AddItem "All"
For RW_Cust = 1 To Range("tblCust").Rows.Count
' add each customer name from customer table name column
.AddItem (Range("tblCust[Name]")(RW_Cust))
Next RW_Cust
End With
End Sub
Does anyone know how to make a userform function in the same way as the Message Box 'ok' button? I'll explain.
I'm detecting errors in a column in a spreadsheet. When an error is found, a message box pops up as follows:
MsgBox "Please enter valid data"
When I select "OK" it goes to the next error in the column. This is great, except of course a message box is modal, which freezes the application. I want the user to be able to edit the data and then move to the next error. So, I designed a userform, which can be non-modal. Great, except I want the macro to advance to the next error. It will do that IF the user corrects the error. If they do not, it just stays at that error cell.
I know WHY this happens. My userform 'Next' button just calls the macro which finds the first error. But what I want to know is if there is a way around this.
Error checking starts at row 19 because that is where user input data starts.
I'm including a link to the spreadsheet here. Module 1 'NextValidationError' works great and proceeds to the next error. Module 14 just hangs at the error until it is resolved. I'd like it to be able to skip.
https://www.dropbox.com/s/yqko5kj19pnauc9/Transparency%20Data%20Input%20Sheet%20for%20Indirect%20Spend%20V7%2009212016%20v2%200.xlsm?dl=0
Can anyone give me advice on how to make module 14 proceed as module 1?
Something like this:
Dim r_start As Long
Sub CheckNames()
Dim r As Long
'Dim emptyRow As Boolean
If r_start = 0 Then r_start = 19
With ActiveSheet
For r = r_start To 5000
'Checks entire row for data. User may skip rows when entering data.
If WorksheetFunction.CountA(.Range(.Cells(r, 1), .Cells(r, 33))) > 0 Then
If ((.Cells(r, 2) = "") <> (.Cells(r, 3) = "")) Or _
((.Cells(r, 2) = "") = (.Cells(r, 4) = "")) Then
MsgBox "Please fill in First and Last Name or HCO in Row " & r & "."
End If
End If
Next
End With
End Sub
Unless I'm mis-reading your code you can combine your two checks with Or.
You will need some method to reset r_start when the user is done checking (if the form stays open after that).
EDIT: here's a very basic example.
UserForm1 has two buttons - "Next" and "Close"
Code for "next" is just:
Private Sub CommandButton1_Click()
ShowErrors
End Sub
In a regular module:
Dim r_start As Long
'this kicks off the checking process
Sub StartChecking()
r_start = 0
UserForm1.Show vbModeless
ShowErrors
End Sub
'a simple example validation...
Sub ShowErrors()
Dim c As Range, r As Long
If r_start = 0 Then r_start = 9
For r = r_start To 200
With ActiveSheet.Rows(r)
If Not IsNumeric(.Cells(1).Value) Then
UserForm1.lblMsg.Caption = "Cell " & .Cells(1).Address() & " is not numeric!"
r_start = r + 1
Exit Sub
End If
End With
Next r
r_start = 0
UserForm1.lblMsg.Caption = "No more errors"
End Sub