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
Related
I created a couple of user forms which operate a data in separate report workbook. My script can successfully proceed a value in digit type. Unfortunately the circumstances have changed and now it has to work with a Serial Numbers as: 29160012040000TZ. With that new value script after starting the Sub, open a report, but it never enter into a 'with' statement. It doesn't look for a value or doing something else. Just open a report workbook and freeze.
Below you can see the code lines where issue is present and a little description:
Single_PHA is a text window in User Form where user can enter a a value, proceeding value is 29160012040000TZ
Private Sub Wydaj_button_Click()
Workbooks.Open Filename:="N:\ENGINEERING\1. ENGINEERS\Mateusz Skorupka\PHA_Cleaning_report_path\PHA_CLEANING_REPORT.xlsm", ReadOnly:=False
Dim REPORT As Workbook
Set REPORT = Application.Workbooks("PHA_CLEANING_REPORT.xlsm")
Set TABLE = REPORT.Worksheets("Main_table")
...
With TABLE.Range("A1")
If Single_PHA = True Then
If Not IsError(Application.Match(Single_PHA.Value, .Range("A:A"), 0)) Then
Single_PHA_row = TABLE.Range("A:A").Find(What:=Single_PHA.Value, LookIn:=xlValues).Row
.Offset(Single_PHA_row - 1, 4).Value = Date
REPORT.Close SaveChanges:=True
Single_PHA.Value = ""
Exit Sub
Else
MsgBox "Numer seryjny głowicy nie istnieje w bazie"
REPORT.Close SaveChanges:=False
Exit Sub
End If
End If
End With
In VBA I don't know how to open something like debugger or make the print instruction which would show me how the variables look on specific steps.
I am not sure if VBA read the value as 29160012040000TZ as string. I tried to declare at the beginning a variable as Single_PHA_STR as String and the proceed it as just text, but no wins there:
Dim Single_PHA_STR As String
...
With TABLE.Range("A1")
If Single_PHA = True Then
Single_PHA_STR = Str(Single_PHA.Value)
If Not IsError(Application.Match(Single_PHA_STR, .Range("A:A"), 0)) Then
Single_PHA_row = TABLE.Range("A:A").Find(What:=Single_PHA_STR, LookIn:=xlValues).Row
.Offset(Single_PHA_row - 1, 4).Value = Date
REPORT.Close SaveChanges:=True
Single_PHA.Value = ""
Exit Sub
Else
MsgBox "Numer seryjny głowicy nie istnieje w bazie"
REPORT.Close SaveChanges:=False
Exit Sub
End If
End If
End With
I noticed that if in VBA IDE I write a bold value 29160012040000TZ, I get an error
Expected line number or label or statement or end of statement
and the value is highlighted in red.
Could someone help me in that field and explain the nature of issues:
To reproduce a situation you can create a simply user form with one TextBox and one CommandButton. In the same worksheet as user form in a column A put a values: 29160012040000 and 29160012042027IR
Then make a sub which execute after double click on command button with code:
Private Sub CommandButton1_Click()
With Worksheets("Sheet1").Range("A1")
If Text_box1 = True Then
If Not IsError(Application.Match(Text_box1.Value, .Range("A:A"), 0)) Then
Text_box1_row = Worksheets("Sheet1").Range("A:A").Find(What:=Text_box1.Value, LookIn:=xlValues).Row
.Offset(Text_box1_row - 1, 4).Value = Date
Text_box1.Value = ""
Exit Sub
Else
MsgBox "PHA SN not exist in a database"
Exit Sub
End If
End If
End With
End Sub
Then try to input in a UserForm's TextBox a value = 29160012040000 and you will see that script successfully filled a forth column in row with current date. Then try to input a value 29160012042027IR and you will see that nothing happened. Script don't proceed that value at all.
So that is my issue and question indeed. How to process a value with letters at the end like: 29160012042027IR : )
I also tried to focus a script statement on one specific cell in which is a text value "29160012042027IR" that which I input into a UserForm TextBox. Looking with a debugger both of variables in if statement have the same text value, but still script miss that statement and go to else instructions : (
I mean abut: If Range("A3").Text = Text_box1.Text Then
When I change a statement for "If Range("A3").Value = Text_box1.Value Then" the same thing happen.
Private Sub CommandButton1_Click()
With Worksheets("Sheet1").Range("A:A")
If Text_box1 = True Then
If Range("A3").Text = Text_box1.Text Then
Text_box1_row = Worksheets("Arkusz1").Range("A:A").Find(What:=Text_box1.Value, LookIn:=xlWhole).Row
.Offset(Text_box1_row - 1, 4).Value = Date
Text_box1.Value = ""
Exit Sub
Else
MsgBox "PHA SN not exist in a database"
Exit Sub
End If
Else
MsgBox "Other loop"
End If
End With
End Sub
IMPORTANT NOTICE:
I found the main issue. I made wrong if condition, it should be:
If Single_PHA <> "" Then previously I have got: If Single_PHA = True Then, and there the results is a value not the boolean type.
Everything works. Thank everyone very much for help.
Topic is ready to be closed.
PS: thank you Tom for suggestion and tip with debugger: )
I've managed to create a form where the user can expand the fields of a pivot table and, once they've completely expanded a field/branch, a button will appear in column E and that pivot field data is concatenated in column J (there are some hidden columns).
What I want is for the user to click an auto-generating button in column E which exports the corresponding data in column J to a list, somewhere on the workbook.
My code below automatically generates the buttons for fully expanded fields, but I have no idea how to write the code to link each button to the corresponding cell in column J - this is probably not very difficult but any help would be appreciated.
Sub buttonGenerator()
Dim btn As Button
Application.ScreenUpdating = False
ActiveSheet.Buttons.Delete
Dim t As Range
Dim size As Integer
size = ActiveSheet.PivotTables("Pivottable1").TableRange2.Rows.Count
For i = 2 To size Step 1
If Not IsEmpty(ActiveSheet.Range(Cells(i, 4), Cells(i, 4))) Then
Set t = ActiveSheet.Range(Cells(i, 5), Cells(i, 5))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "btnS"
.Caption = "Add to summary" '& i
.Name = "Btn" & i
End With
End If
Next i
Application.ScreenUpdating = False
End Sub
Sub buttonAppCaller()
MsgBox Application.Caller
End Sub
So here is my code .. it is throwing Runtime error 1004 "Unable to get the Buttons property of the worksheet class". Not sure what I've done wrong but I need to get the data from the cell next to the button to copy over to the bottom of a list in sheet 2 when that particular button is clicked. Please help!
Sub btnS()
Dim dest As Range
Dim origin As Range
origin = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Offset(0, 1) 'input data from cell next to button click
dest = Worksheets("Form Output").Range("A1") 'output data to list in sheet 2 - "Form output"
Set dest = origin
End Sub
Don't use Integer for row counts as you did for size. Excel has more rows than Integer can handle. It is recommended always to use Long instead of Integer in VBA there is no benefit in Integer at all.
The procedure every button invokes is called btnS as you defined in .OnAction = "btnS". Therefore you need a Sub with that name in a Module.
You can use Buttons(Application.Caller).TopLeftCell to get the cell under a button and from that cell you can determine the row or column.
Public Sub btnS() 'sub name must match `.OnAction` name
MsgBox ActiveSheet.Buttons(Application.Caller).TopLeftCell.Row
End Sub
Instead of using ActiveSheet I recommend to use a specific worksheet like Worksheets("your-sheet-name") if you plan to use it on a specific sheet only. ActiveSheet can easily change and should be avoided where possible.
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
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
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