I made a workbook that has a userform thar is used to fill information in a new row, the information in the textboxes should be prefilled by using the information on the row below. This has to be repeated as many times as an input box value.
So far so good, but now I also need the users to be able to view other sheets in the same workbook where the required information is stored while the userform is open.
if I show the userform modeless I can view other sheets but then the code just keeps going and the second time the userform should pop up it doesn't.
I found a solution to that: using DoEvent.
but now the information is not (pre)filled correctly
Private Sub CommandButton2_Click()
Dim myValue As String
myValue = InputBox("How many do you have?")
If StrPtr(myValue) = 0 Then Exit Sub
For i = 1 To myValue
Range("A4").EntireRow.Insert
UserForm1.Show vbModeless
Do While UserForm1.Visible
DoEvents
Loop
Next
End Sub
What happens now is that the information from a row below is used regardless of any changes made by the user.
Does anyone have a solution?
Edit:
I don't think it is immediately required to understand my question but it might help a bit..
The rest of the code from the userform is as follows
Private Sub CommandButton1_Click()
Unload UserForm1
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
Range("A4").EntireRow.delete
End
End If
End Sub
Private Sub TextBox1_Change()
Dim myValue As Variant
myValue = TextBox1
Range("A4").Value = myValue
End Sub
Private Sub UserForm_Initialize()
Me.TextBox1.Value = Format(Range("A2"), "dd/mm/yyyy")
Me.TextBox2.Value = Range("B5").Value
Me.TextBox3.Value = Range("C5").Value
Me.TextBox4.Value = Range("D5").Value
Me.TextBox5.Value = Range("E5").Value
Me.TextBox6.Value = Range("F5").Value
Me.TextBox7.Value = Range("G5").Value
Me.TextBox8.Value = Range("H5").Value
Me.TextBox9.Value = Range("J5").Value
Me.TextBox10.Value = Range("K5").Value
End Sub
Private Sub TextBox10_Change()
Dim myValue As Variant
myValue = TextBox10
Range("K4").Value = myValue
End Sub
Private Sub TextBox11_Change()
End Sub
Private Sub TextBox2_Change()
Dim myValue As Variant
myValue = TextBox2
Range("B4").Value = myValue
End Sub
Private Sub TextBox3_Change()
Dim myValue As Variant
myValue = TextBox3
Range("C4").Value = myValue
End Sub
Private Sub TextBox4_Change()
Dim myValue As Variant
myValue = TextBox4
Range("D4").Value = myValue
End Sub
Private Sub TextBox5_Change()
Dim myValue As Variant
myValue = TextBox5
Range("E4").Value = myValue
End Sub
Private Sub TextBox6_Change()
Dim myValue As Variant
myValue = TextBox6
Range("F4").Value = myValue
End Sub
Private Sub TextBox7_Change()
Dim myValue As Variant
myValue = TextBox7
Range("G4").Value = myValue
End Sub
Private Sub TextBox8_Change()
Dim myValue As Variant
myValue = TextBox8
Range("H4").Value = myValue
End Sub
Private Sub TextBox9_Change()
Dim myValue As Variant
myValue = TextBox9
Range("J4").Value = myValue
End Sub
~~
I figured that it indeed had to do with the fact that your initial code did not retrigger the TextBox#_Change subs as intended. I did it a little differently, and triggered them in CommandButton2_Click. This way, you don't need to reload really. But whatever works; just sharing for comparison. So, I am assuming a UserForm like this:
We will move row 4 down on Confirm Input. On Cancel, we'll clear it and exit. And on Confirm Input, the user will (continuously) be asked whether he wants to submit another entry. If not, we'll clear row 4 and exit as well.
So, I've rewritten these parts:
Private Sub CommandButton1_Click()
Range("A4").EntireRow.ClearContents
Unload UserForm1
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
Range("A4").EntireRow.ClearContents
Range("A4").Resize(1, 11).Interior.Color = vbYellow
End
End If
End Sub
Private Sub CommandButton2_Click()
Range("A4").Resize(1, 11).Interior.Color = vbWhite
Range("A4").Resize(1, 11).Insert
Range("A4").Resize(1, 11).Interior.Color = vbYellow
For i = 1 To 10
myValue = Me.Controls("TextBox" & i).Value
Me.Controls("TextBox" & i).Value = ""
Me.Controls("TextBox" & i).Value = myValue
Next i
answer = MsgBox("Do you wish to add another row?", vbYesNo)
If answer = vbYes Then
Else
Range("A4").EntireRow.ClearContents
Unload UserForm1
End If
End Sub
Private Sub TextBox1_Change()
Dim myValue As Variant
myValue = TextBox1
If myValue = "" Then
Range("A4").Value = myValue
Else
Range("A4").Value = CDate(myValue)
End If
End Sub
You might want to get rid of the color (re)setting bits. But it may be good to realize that the practice of inserting rows all the time may have unintended effects for formatting. Suppose, for whatever reason, you want row 6 to have a red background. As is, the code will keep pushing this formatting one row down each time. This may be what you want, of course... Other than that, the "update" for TextBox1_Change makes sure you export an actual Excel Date, not a string.
Final warning (since we're using vbModeless): be aware that (both in your code and mine) there is no reference to the worksheet. Suppose your user goes into another sheet and clicks Confirm Input there, this will trigger Range("A4").Resize(1, 11).Insert inside the wrong sheet! Seems highly advisable to fix this.
I found a way..
I now changed the sub names of the textbox#_change subs and call them all on "userform unload".
Private Sub CommandButton1_Click() ' this is the command button on the userform
Call TX1
Unload UserForm1
End Sub
Related
I have three buttons in userform S1,S2,S3(sheet1,sheet2..) which assign a value specified in the textbox to the first cell on a sheet. How to do that after closing user form show sheet
into which the value was entered/last used sheet
Private Sub Zamknij_Click()
UserForm1.Hide
Worksheets("SheetName").Activate
End Sub
Private Sub Sheet1_Click()
Sheets(1).Cells(1, 1).Value = TextBox1.Value
End Sub
Private Sub Sheet2_Click()
Sheets(2).Cells(1, 1).Value = TextBox1.Value
End Sub
Private Sub Sheet3_Click()
Sheets(3).Cells(1, 1).Value = TextBox1.Value
End Sub
Putting my comments into code: Here is one possible way to implement what I think it is you're trying to do.
Private Sub Zamknij_Click()
Unload Me
End Sub
Private Sub Sheet1_Click()
ApplyToSheet Worksheets(1)
End Sub
Private Sub Sheet2_Click()
ApplyToSheet Worksheets(2)
End Sub
Private Sub Sheet3_Click()
ApplyToSheet Worksheets(3)
End Sub
Sub ApplyToSheet(wsSheet As Worksheet)
With wsSheet
.Activate
.Cells(1, 1) = TextBox1.Value
End With
End Sub
The above will show the target and then write TextBox1.
If you need to keep another or the current sheet visible until Zamknij is clicked, here is another approach:
Option Explicit
'At the top of the userform (before any subs): Declare a module-level variable
Private mwsTarget As Worksheet
Private Sub Zamknij_Click()
mwsTarget.Activate
Unload Me
End Sub
Private Sub Sheet1_Click()
ApplyToSheet Worksheets(1)
End Sub
Private Sub Sheet2_Click()
ApplyToSheet Worksheets(2)
End Sub
Private Sub Sheet3_Click()
ApplyToSheet Worksheets(3)
End Sub
Sub ApplyToSheet(wsSheet As Worksheet)
Set mwsTarget = wsSheet
wsSheet.Cells(1, 1) = TextBox1.Value
End Sub
I have the following code that works as expected:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim cmdBtn As CommandBarButton
Dim currentUPC As String
Dim currentArticle As String
Set cmdBtn = Application.CommandBars("Cell").FindControl(, , "testBt")
If Intersect(Target, Range("C21:C42")) Is Nothing Then
If Not cmdBtn Is Nothing Then cmdBtn.Delete
Exit Sub
End If
If Not cmdBtn Is Nothing Then Exit Sub
Set cmdBtn = Application.CommandBars("Cell").Controls.Add(Temporary:=True)
currentUPC = ActiveCell.Value
currentArticle = ActiveCell.Offset(0, 1).Value
With cmdBtn
.Tag = "testBt"
.Caption = "Goto UPC"
.Style = msoButtonCaption
.OnAction = "=gotoUPC(" & currentUPC & ")"
End With
End Sub
But the macro it runs is not quite working as planned:
Sub gotoUPC(currentUPC As String)
Sheets("UPC Summary").Range("A21").Value = currentUPC
Worksheets("UPC Summary").Activate
End Sub
The value in Range A21 updates correctly but it will not activate the worksheet as required.
Any additional thoughts on my method of passing the parameter appreciated #FaneDuru
Any thoughts appreciated, many thanks, Alan.
If you want to go to the worksheet 'UPC Summary' you could use this.
Application.Goto Sheets("UPC Summary").Range("A1"), True
Tried looking this up but I'm still new to VBA and still pretty confused. I can't figure out how to get the variable from one sub and use it in another sub.
I want to get the variable ListBox1Items from GetListBox1Items and use it in cbSave_Click. I keep getting an error on Set oNewRow = Selection.ListObject.ListRows.Add(1). I tried Dim ListBox1Items As String and Public ListBox1Items As String but that doesn't help.
Does the module location of the sub matter? GetListBox1Items is in a Module. cbSave_Click is in a UserForm.
I looked up using Types but it got confusing.
Private Sub cbSave_Click()
Dim oNewRow As ListRow
Dim rng As Range
Set rng = ThisWorkbook.Worksheets("Creatures").Range("MonsterList")
Set oNewRow = Selection.ListObject.ListRows.Add(1)
With ws
Call GetListBox1
oNewRow.Range.Cells(1, 24).Value = Me.StatBox1.Value
oNewRow.Range.Cells(1, 35).Value = ListBox1Items
End With
End Sub
and GetListBox1 is
Sub GetListBox1()
Dim SelectedItems As String
Dim ListBox1Items As String
With MonsterMaker
For i = 0 To .ListBox1.ListCount - 1
If .ListBox1.Selected(i) = True Then
SelectedItems = SelectedItems & .ListBox1.List(i) & ", "
End If
Next i
ListBox1Items = Left(SelectedItems, Len(SelectedItems) - 2)
End With
End Sub
Take the follow abstract example:
Standard module code:
Option Explicit
Public ListBoxItems As String 'GLOBAL
Sub GetListBoxItems()
Dim selectedItems As String
Dim i as long
With ThisWorkBook.Worksheets("Sheet1").OLEObjects("ListBox1").Object 'amend as appropriate
For i = 0 to .ListCount-1
If .Selected(i) Then
selectedItems = selectedItems & .List(i) & ", "
End If
Next i
ListBoxItems = Left$(selectedItems,Len(selectedItems)-2)
End With
End Sub
In UserForm code:
Private Sub cbSave_Click()
Call GetListBoxItems
Debug.Print ListBoxItems
End Sub
Employee Login System using Excel with Macro.
I'm using a very simple technique of "if elseif then"
I want to display Employee Name when their ID is typed.
I used very simple code:
Dim CM As Boolean
Dim UserRange As Range
Dim x As Range
'EASY
Private Sub cmdClear_Click()
txtEmpID.Value = ""
txtName.Value = ""
txtEmpID.SetFocus
End Sub
Private Sub cmdLogin_Click()
End Sub
Private Sub txtEmpID_Change()
'If txtEmpID.Value = "111" Then
'txtName.Value = "Ryan"
'
'ElseIf txtEmpID.Value = "222" Then
'txtName.Value = "Tim"
'
'End If
End Sub
Private Sub UserForm_activate()
Do
If CM = True Then Exit Sub
TextBox1 = Format(Now, "hh:mm:ss")
DoEvents
Loop
Set UserRange = Sheets("Sheet1").Range("B:B")
For Each x In UserRange.Cells
If x.Value = txtEmpID.Text Then
x.Offset(1, 0) = txtName.Value
End If
Exit For
Next x
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
CM = True
End Sub
However I want to have a sheet that holds Employee Name (column A) and ID(column B) Sheet
Then from there, I can add more employee names and IDs. Also when I click on Login it will display the current time in Column C and then It will also display their time-out. Here's my main form Main Form
Thank you so much.
Not 100% sure I understand but here's my response:
Here's a way to update the field from the worksheet:
Private Sub txtEmpID_Change()
Dim mySheet As Worksheet
Dim myRange As Range
Set mySheet = Sheets("Emp_ID")
Set myRange = mySheet.Range("B:B").Find(txtEmpID.Value, , , xlWhole)
If Not myRange Is Nothing Then
txtName.Value = myRange.Offset(0, -1)
Else
txtName.Value = "Match not found"
End If
End Sub
Set that to occur whenever there's an update.
As for recording the login time: myRange.offset(0,1) = Format(Now,"hh:mm:ss")
How will you know / display the logout time when someone is logging in?
i tried various methods to select multiple sheets in the list box and returning the selected sheet names into the msgbox. can any one help doing this.
currently i am able to populate the sheet names in the list box.However i am not getting the all selected sheet names in the msgbox.
Public listChoice As String
Private Sub UserForm_Activate()
For n = 1 To ActiveWorkbook.Sheets.Count
With ListBox1
.AddItem ActiveWorkbook.Sheets(n).Name
End With
Next n
End Sub
Private Sub ListBox1_AfterUpdate()
listChoice = ListBox1.Text
End Sub
Private Sub CommandButton1_Click()
MsgBox (listChoice)
End Sub
Getting the selected item in a listbox isn't as straightforward as you'd want it to be:
Private Sub CommandButton1_Click()
Dim Msg As String
Dim i As Integer
Msg = "You selected" & vbNewLine
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
Msg = Msg & ListBox1.List(i) & vbNewLine
End If
Next i
MsgBox Msg
End Sub
credit: http://www.java2s.com/Code/VBA-Excel-Access-Word/Forms/GettheselecteditemsinaListBox.htm
You don't need the ListBox1_AfterUpdate() Sub or the public listChoice variable with this code
This msgbox the selected items in listbox.
Private Sub CommandButton1_Click()
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
Msg = ListBox1.List(i) & vbNewLine
End If
Next i
MsgBox Msg
End Sub
Something like this may assist,
Private strOP As String
Private dicSelections As Scripting.Dictionary
Private Sub ListBox1_Mouseup(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim strSheet As String
strSheet = Me.ListBox1.List(Me.ListBox1.ListIndex)
If Me.ListBox1.Selected(Me.ListBox1.ListIndex) Then
If Not dicSelections.Exists(strSheet) Then
dicSelections.Add strSheet, strSheet
Else
End If
Else
If dicSelections.Exists(strSheet) Then
dicSelections.Remove strSheet
End If
End If
End Sub
Private Sub UserForm_Click()
Me.ListBox1.AddItem "one"
Me.ListBox1.AddItem "two"
Me.ListBox1.AddItem "three"
End Sub
Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Debug.Print "Worksheets selected " & Join(dicSelections.Items(), " & ")
End Sub
Private Sub UserForm_Initialize()
Set dicSelections = New Scripting.Dictionary
End Sub