I have an excel document that has 5 successive cells on 1 column that need to be filled in with data. I am looking to create a VBA userForm that will go through a line of questioning to help the user input the correct data.
Lets say that the 5 cells are A1 through A5. Once the userform is called it should show a question(label maybe?), A text box for the input of data, and a command button to move on the the next question. all the while moving from A1 to A2 and so on until the line of questioning is done.
Does anybody have any idea how to accomplish this? My VB knowledge is basic but i have tried and tried to no avail.
Thanks in advance!
Given a form like this:
You could set your questions up in an array and iterate through them each button press while setting the answers to your sheet.
Dim i As Integer
Dim str(1 To 3) As String
Private Sub UserForm_Initialize()
i = 1
str(1) = "Question 1"
str(2) = "Question 2"
str(3) = "Question 3"
btnNext.Default = True
lblQuestion.Caption = str(i)
txtAnswer.SetFocus
End Sub
Private Sub btnNext_Click()
Sheets("Sheet1").Cells(i, 1).Value = txtAnswer.Text
i = i + 1
If i = UBound(str) + 1 Then
UserForm1.Hide
Exit Sub
End If
lblQuestion.Caption = str(i)
txtAnswer.Text = ""
txtAnswer.SetFocus
End Sub
Example of Result:
Related
Is there a way to put a page number in a cell that updates upon printing?
I set Row 1-5 as to repeat on every page. However, I would like the Page value in Cell F1 to update on each page upon printing. Is there a way to do this?
Thank you.
I think, there's no direct way to increase cell value upon printing.
But you can use VBA, how to use VBA? You can search it.
My question, where's the print out area?
I assume the print area from the same sheet.
Here the code :
Sub forprint()
Dim nPrint As Variant
Dim i, n As Long
On Error Resume Next
n = Range("F1").Value
nPrint = Application.InputBox("Number of Copy", "Print")
If TypeName(nPrint) = "Boolean" Then Exit Sub
If (nPrint = "") Or (Not IsNumeric(nPrint)) Or (nPrint < 1) Then
MsgBox "Enter number only & minimum 1 copy", vbExclamation, "Wrong character or value!"
Else
Application.ScreenUpdating = False
For i = 1 To nPrint
ActiveSheet.Range("F1").Value = n + nPrint
Sheets("Sheet1").PrintOut '<< change Sheet1 to your sheet with the printarea
Next
Application.ScreenUpdating = True
End If
End Sub
Insert Module at VBA window. Click Insert >> Module then paste the code in the Module window, then press F5 to run the code.
i have a patient list and i have used a listbox userform in order to select multiple diagnosis codes. I am only able to apply that listbox to the first cell, a2. regardless where i click in that column, i am unable to get the diganosis codes for the next patient to fall into the next row in that diganosis column. When i make a selection, they are returning back to cell a2, regardless of where i am selecting. The code i currently have is below. Can someone please help?
Private Sub CommandButton1_Click()
myVar = ""
For x = 0 To Me.LLBXMedHist.ListCount - 1
If Me.LLBXMedHist.Selected(x) Then
If myVar = "" Then
myVar = Me.LLBXMedHist.List(x, 0)
Else
myVar = myVar & "," & Me.LLBXMedHist.List(x, 0)
End If
End If
Next x
ThisWorkbook.Sheets("Sheet1").Range("a2") = myVar
End Sub
I will admit to being a terrible at code, and have always struggled with Macros... forgive my ignorance.
What I am working on building is a part number index that will create a new sequential number within a numerical series after a macro-button is pressed.
I'd like each button to scan between a range [i.e. 11-0000 (MIN) and 11-9999 (MAX)] and select the max value cell that exists. At that selection point insert an entire new row below with the next + 1 sequential number in the "B" column.
I have my button creating the table row as I would like, however I need help in defining the ".select(=Max(B:B))" and as I understand Max will also limit the # of line items it queries?
I have also been playing with .Range("B" & Rows.CountLarge) with little to no success.
Ideally the 11-**** button [as seen in the screen cap] should insert a sequential number below the highlighted row.
Maybe I'm way over my head, but any guidance even in approach or fundamental structure of the code would help be greatly appreciated!
Private Sub CommandButton1_Click()
Sheets("ENGINEERING-PART NUMBERS").Range("B" & Rows.CountLarge).End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.EntireRow.Insert Shift:=xlDown
ActiveCell.Value = "=ActiveCell + 1"
End Sub
Screen Cap of Spread Sheet
Perhaps there is a simpler solution that I've overlooked, but the below will work.
Insert a module into your workbook and add this code:
Public Sub AddNextPartNumber(ByVal FirstCellInColumn As Range, Optional ByVal PartMask As Variant = "")
Dim Temp As Variant, x As Long, MaxValueFound(1 To 2) As Variant
'Some error checking
If PartMask = "" Then
MsgBox "No part mask supplied", vbCritical
Exit Sub
ElseIf Not PartMask Like "*[#]" Then
MsgBox "Invalid part mask supplied; must end in ""#"".", vbCritical
Exit Sub
ElseIf PartMask Like "*[#]*[!#]*[#]" Then
MsgBox "Invalid part mask supplied; ""#"" must be continuous only.", vbCritical
Exit Sub
End If
'Get the column of data into an array
With FirstCellInColumn.Parent
Temp = .Range(FirstCellInColumn, .Cells(.Rows.Count, FirstCellInColumn.Column).End(xlUp))
End With
'Search through the array and find the largest matching value
For x = 1 To UBound(Temp, 1)
If Temp(x, 1) Like PartMask Then
If MaxValueFound(1) < Temp(x, 1) Then
MaxValueFound(1) = Temp(x, 1)
MaxValueFound(2) = x
End If
End If
Next x
'Output new part number
If MaxValueFound(2) = 0 Then
'This part mask doesn't exist, enter one with 0's at the end of the list
With FirstCellInColumn.Offset(x - 1, 0)
.Value = Replace(PartMask, "#", 0)
.Select
End With
Else
'Get the length of the number to output
Dim NumberMask As String, NumFormatLength As Long
NumFormatLength = Len(PartMask) - Len(Replace(PartMask, "#", ""))
NumberMask = String(NumFormatLength, "#")
'Determine the new part number
MaxValueFound(1) = Replace(MaxValueFound(1), Replace(PartMask, NumberMask, ""), "")
MaxValueFound(1) = Replace(PartMask, NumberMask, "") & Format((MaxValueFound(1) * 1) + 1, String(NumFormatLength, "0"))
'Insert row, add new part number and select new cell
FirstCellInColumn.Offset(MaxValueFound(2), 0).EntireRow.Insert
With FirstCellInColumn.Offset(MaxValueFound(2), 0)
.Value = MaxValueFound(1)
.Select
End With
End If
End Sub
Then, for each button, you write the code like this:
Private Sub CommandButton1_Click()
'this is the code for the [ADD 11-****] button
AddNextPartNumber Me.Range("B16"), "11-####"
End Sub
Private Sub CommandButton2_Click()
'this is the code for the [ADD 22-****] button
AddNextPartNumber Me.Range("B16"), "22-####"
End Sub
This has been written assuming that inserting a new row onto your sheet won't affect other data and that adding new data to the bottom of the table without inserting a row also won't affect other data.
Assuming you're working with a table, by default it should auto-resize to include new data added to the last row.
Good luck learning the ropes. Hopefully my comments help you understand how what I wrote works.
I work on sheet 1 and sheet 2 and in both sheets there are shapes that contain code. The Shape ID in sheet 1 is "RUN 1" and in sheet 2 is "EQ-1". I already have a code that can identify the shape ID I've clicked on sheet1 / sheet2. But the code is debug with the explanation "the item with the specified name wasn't found". Thanks. Please help :)
This code must be located in the sheet 2
sub x ()
'the first trial
If Sheet1.Shapes(Application.Caller).Name = "RUN 1" Then Sheet2.Cells(1, 2) = "x"
If activesheet.Shapes(Application.Caller).Name = "EQ-1" Then Sheet2.Cells(1, 2) = "x"
'the second trial
If Sheet1.Shapes(Application.Caller).Name = "RUN 1" Or _
activesheet.Shapes(Application.Caller).Name = "EQ-1" Then Sheet2.Cells(1, 2) = "x"
end sub
Try...
Sub x()
If Application.Caller = "RUN 1" Or Application.Caller = "EQ-1" Then
Sheet2.Cells(1, 2) = "x"
End If
End Sub
Hope this helps!
I don't know how to take action with the VBA Userform here.
I have a userform which allows users add more textboxes and type the value to the textboxes. I want to copy those values from each additional textbox to separate cells. This is what I did, but not working.
Label "Add textbox after clicking_THIS ONE IS WORKING"
Private Sub CommandButton2_Click()
x = Me.Controls.count + 1
Set xx = Controls.Add("Forms.TextBox.1", "CtrlName" & x)
xx.Top = x * 20 - 108
xx.Left = 396
xx.Width = 288
End Sub
Label "Get value from textboxes to cell_THIS IS NOT WORKING"
Private Sub CommandButton1_Click()
Dim count as Integer
Dim i as Integer
count = Me.Controls.count - 9 ("I have 9 other controls, so need to - 9 to count the number of textboxes")
For i = 1 To count
Cells(i, 1).Select
ActiveCell.Value = Me.Controls("TextBox" & i).Value
Next i
End Sub
The problem is the Me.Controls ("TextBox" & I).Value. I tried different funtions here, but still couldn't solve that.
You have named your textboxes CtrlName10, CtrlName11, etc. You must use those names, not TextBox1 etc. Which means that the value is Me.Controls("CtrlName" & (i + 9)).Value.
Hint: In error box saying Could not find the specified object press the button Debug. This will return you to the code editor, with the offending statement highlighted, and you can examine the variables in the Locals pane (on the View menu).