I have two commands button the first to post data and the second to run macro
how could I merge these two commands in one button?
as I need to post data then run macro
Private Sub post_Click()
If Me.today.Value = "" Then
MsgBox " You should enter contract date "
Exit Sub
End If
If Not (Me.percentage.Value = "" Xor Me.txtamount.Value = "") Then
MsgBox "You should select % or amount"
Exit Sub
End if
Dim ws As Worksheet
Set ws = Worksheets("6 Y")
ws.Cells(3, 17).Value = ComboBox2.Text
ws.Cells(4, 17).Value = Price.Text
ws.Cells(6, 19).Value = today.Text
ws.Cells(7, 24).Value = percentage.Text
ws.Cells(7, 25).Value = txtamount.Text
ws.Cells(1, 27).Value = ComboBoxpmtplan.Text
End Sub
Private Sub COMMRUN_Click()
Macro1
End Sub
You can simply call the function by name
Private Sub COMMRUN_Click()
Macro1
post_Click
End Sub
Related
I have a little problem with my vba code. I'm trying to fill in a table by using a userform.
They only have to fill in 3 values:
userform
After the first time they clicked "Toevoegen" the line gets added properly into the table by this code:
Private Sub cbToevoegen_Click()
Dim emptyRow As Long
Dim artikelnr As Long
'Validation
If IsDate(Me.tbDatum) = False Then
MsgBox "Geef een geldige datum in vb.: 14-02-2022"
Me.tbDatum.SetFocus
Exit Sub
End If
If Me.cbArtikel.ListIndex = -1 Then
MsgBox "Selecteer een Artikel uit de lijst"
Me.cbArtikel.SetFocus
Exit Sub
End If
If IsNumeric(Me.tbAantal) = False Then
MsgBox "Vul een geldig aantal in."
Me.tbAantal.SetFocus
Exit Sub
End If
shBewegingen.Activate
With shBewegingen
'Bepaal de laatste rij
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Voeg inboeking toe
.Cells(emptyRow, 1).Value = Me.tbDatum
.Cells(emptyRow, 2).Value = "IN"
artikelnr = Val(Left(Me.cbArtikel, 5))
.Cells(emptyRow, 3).Value = artikelnr
.Cells(emptyRow, 4).Value = Val(Me.tbAantal)
.Cells(emptyRow, 6).Value = Environ("Username")
End With
shMagazijnbeheer.Activate
Me.cbArtikel.ListIndex = -1
Me.tbAantal = ""
End Sub
But the second time it just seems to fill in the first cell (with the date) and then jumps out of the sub...
What do I do wrong?
Table
Edit: It seems to go wrong when I choose for a second time the same artikel from the field cbArtikel...
Already thanks!
I'm using a vba UserForm to enter in "Vehicle Reg" and choose "Current Status" from a combobox, which currently adds this data to a new line along with a uniqueID, the username, and the time.
I'd like to create a finite list of Vehicle Reg, and use the UserForm to update the Current Status (1 column to the right) with the new value.
Is there a way I can alter what I have to make this work? I am brand new to vba and have been googling for days!
I have a Submit Button, a Reset Button, and on the main spreadsheet I have a macro button that I have attached the "Show Form".
Here's what I have:
Sub Reset()
Dim iRow As Long
iRow = [Counta(Database!A:A)] 'identifying the last row
With frmForm
.txtID.Value = ""
.cmbStatus.Clear
.cmbStatus.AddItem "Loaded - In"
.cmbStatus.AddItem "Loaded - Out"
.cmbStatus.AddItem "Empty - Parked"
.cmbStatus.AddItem "Empty - On Bay"
.lstDatabase.ColumnCount = 4
.lstDatabase.ColumnHeads = True
If iRow > 1 Then
.lstDatabase.RowSource = "Database!A2:C" & iRow
Else
.lstDatabase.RowSource = "Database!A2:C2"
End If
End With
End Sub
Sub Submit()
Dim sh As Worksheet
Dim iRow As Long
Set sh = ThisWorkbook.Sheets("Database")
iRow = [Counta(Database!A:A)] + 1
With sh
.Cells(iRow, 1) = iRow - 1
.Cells(iRow, 2) = frmForm.txtID.Value
.Cells(iRow, 3) = frmForm.cmbStatus.Value
.Cells(iRow, 4) = Application.UserName
.Cells(iRow, 5) = [Text(Now(), "DD-MM-YYY HH:MM:SS")]
End With
End Sub
Sub Show_Form()
Call Reset
frmForm.Show
End Sub
**And my initialize code:**
Private Sub UserForm_Initialize()
With frmForm
Height = 370
Width = 645
End With
End Sub
Private Sub cmdReset_Click()
Dim msgValue As VbMsgBoxResult
msgValue = MsgBox("Do you want to reset the form?", vbYesNo + vbInformation, "Confirmation")
If msgValue = vbNo Then Exit Sub
Call Reset
End Sub
Private Sub cmdSave_Click()
With Me
If txtID.Value = "" Then
MsgBox "Reg Cannot Be Blank", vbOKOnly + vbCritical + vbDefaultButton1, "Reg Blank"
End If
Exit Sub
End With
Dim msgValue As VbMsgBoxResult
msgValue = MsgBox("Do you want to save?", vbYesNo + vbInformation, "Confirmation")
If msgValue = vbNo Then Exit Sub
Call Submit
Call Reset
Unload Me
End Sub
Private Sub frmForm_Initialize()
Call Reset
End Sub
Thanks!
Use the lstDatabase_Click() event together with the .ListIndex property to load the form items from the sheet. The Reset de-selects the line. Save without a line selected adds a new record, with line selected updates the existing record.
Option Explicit
Sub Show_Form()
frmForm.Show
End Sub
Private Sub cmdReset_Click()
' unselect line lstdatabase
With Me
.txtID.Value = ""
.cmbStatus = ""
.lstDatabase.ListIndex = -1
End With
End Sub
Private Sub UserForm_Initialize()
With Me
.Height = 370
.Width = 645
.txtID.Value = ""
.cmbStatus.Clear
.cmbStatus.AddItem "Loaded - In"
.cmbStatus.AddItem "Loaded - Out"
.cmbStatus.AddItem "Empty - Parked"
.cmbStatus.AddItem "Empty - On Bay"
.lstDatabase.ColumnCount = 4
.lstDatabase.ColumnHeads = True
End With
LoadDatabase
End Sub
Private Sub cmdSave_Click()
If txtID.Value = "" Then
MsgBox "Reg Cannot Be Blank", vbCritical, "Reg Blank"
ElseIf cmbStatus.Value = "" Then
MsgBox "Status Cannot Be Blank", vbCritical, "Status Blank"
ElseIf MsgBox("Do you want to save?", vbYesNo, "Confirmation") = vbYes Then
Call Submit
'Unload Me
End If
End Sub
Sub Submit()
Dim i As Long, r As Long
With lstDatabase
i = .ListIndex
' is line selected
If i >= 0 Then r = .List(i, 0) + 1
End With
' update or add
With Sheets("Database")
' add new find last line
If r = 0 Then
r = 1 + .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(r, 1) = r - 1
.Cells(r, 2) = frmForm.txtID.Value
End If
' update
.Cells(r, 3) = frmForm.cmbStatus.Value
.Cells(r, 4) = Application.UserName
.Cells(r, 5) = [Text(Now(), "DD-MM-YYY HH:MM:SS")]
End With
End Sub
Private Sub lstDatabase_Click()
Dim i As Long, r As Long
With lstDatabase
i = .ListIndex
If i >= 0 Then
txtID.Value = .List(i, 1)
cmbStatus.Text = .List(i, 2)
End If
End With
End Sub
Sub LoadDatabase()
Dim iRow As Long
With Sheets("Database")
iRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
If iRow < 2 Then iRow = 2
lstDatabase.RowSource = "Database!A2:C" & iRow
End Sub
I am completely new in this and got stuck on something that sounds like a simple thing.
I created simple user form, where assemblers will enter one of the items as a search criteria. The listbox is then populated with all results from original spreadsheet showing the location of that part. Assembler will then select one item that they need to pick and click the button "pick".
What that will do is enter the date in "PickDate" in spreadsheet. And that is where I am stuck.
My thinking was to select the row in the spreadsheet identical to the selected row in listbox, and then create address of the cell using that row and column. But it doesn't work. Tried several things that I could find on internet and nothing works. At one point I had date being entered in correct column, but not correct row. Unfortunately, cannot remember what that code was.
Any help would be appreciated.
Thanks a lot. userform spreadsheet
Private Sub PickBtn_Click()
Dim i As Integer
For i = 1 To Range("A10000").End(xlUp).Row
If Cells(i, 2) = Results.List(Results.ListIndex) Then
Rows(i).Select
.Range(Selection, 7).Value = Date
End If
Next i
End Sub
Entry form
Private Sub CancelJob_Click()
'Close EntryForm form
Unload EntryForm
'Show InitialForm form
InitialForm.Show
End Sub
Private Sub UserForm_Initialize()
'Empty all fields
JobBox.Value = ""
Customer.Value = ""
Location.Value = ""
Rack.Value = ""
'Fill combo box with product types
With ProductCombo
.AddItem "Channel Letter Faces"
.AddItem "Channel Letter Backers"
.AddItem "Routed Aluminum Panels"
.AddItem "Routed ACM Panels"
End With
'Set focus on Work order TextBox
JobBox.SetFocus
End Sub
Private Sub SubmitJob_Click()
'Make fields mandatory
If JobBox.Value = "" Or ProductCombo.Value = "" Or Rack.Value = "" Then
If MsgBox("Cannot submit. Please fill the mandatory fields.",
vbQuestion + vbOKOnly) <> vbOKOnly Then
Exit Sub
End If
End If
'Start transfering process
Dim emptyRow As Long
'Make Sheet1 active
Sheet1.Activate
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Transfer information to the table
Cells(emptyRow, 1).Value = Date 'Auto populate 1st column with submission date
Cells(emptyRow, 2).Value = JobBox.Value
Cells(emptyRow, 3).Value = Customer.Value
Cells(emptyRow, 4).Value = Location.Value
Cells(emptyRow, 5).Value = ProductCombo.Value
Cells(emptyRow, 6).Value = Rack.Value
'Save workbook after transfer of data
ActiveWorkbook.Save
'Close EntryForm
Unload Me
'Quit application so that others can use it
'Application.Quit
End Sub
This is complete code for this search part of the userform that I cannot
figure out (I was playing with the code for "submit" button that I am stuck). Maybe it will help for troubleshooting:
Private Sub ClearForm(Except As String)
' Clears the list box and text boxes EXCEPT the text box
' currently having data entered into it
Select Case Except
Case "Job"
FormEvents = False
Customer.Value = ""
Location.Value = ""
Results.Clear
FormEvents = True
Case "Customer"
FormEvents = False
Job.Value = ""
Location.Value = ""
Results.Clear
FormEvents = True
Case "Location"
FormEvents = False
Job.Value = ""
Customer.Value = ""
Results.Clear
FormEvents = True
Case Else
FormEvents = False
Job.Value = ""
Customer.Value = ""
Location.Value = ""
Results.Clear
FormEvents = True
End Select
End Sub
Private Sub ClearBtn_Click()
ClearForm ("")
End Sub
Private Sub Job_Change()
If FormEvents Then ClearForm ("Job")
End Sub
Private Sub Customer_Change()
If FormEvents Then ClearForm ("Customer")
End Sub
Private Sub Location_Change()
If FormEvents Then ClearForm ("Location")
End Sub
Private Sub PickBtn_Click()
Dim i As Integer
Sheet1.Activate
For i = 1 To Range("A10000").End(xlUp).row
If Cells(i, 2) = Results.List(Results.ListIndex) Then
Rows(i).Select
Me.Range("Selection:G").Value = Date
End If
Next i
End Sub
Private Sub SearchBtn_Click()
Dim SearchTerm As String
Dim SearchColumn As String
Dim RecordRange As Range
Dim FirstAddress As String
Dim FirstCell As Range
Dim RowCount As Integer
' Display an error if no search term is entered
If Job.Value = "" And Customer.Value = "" And Location.Value = "" Then
MsgBox "No search term specified", vbCritical + vbOKOnly
Exit Sub
End If
' Work out what is being searched for
If Job.Value <> "" Then
SearchTerm = Job.Value
SearchColumn = "Job"
End If
If Customer.Value <> "" Then
SearchTerm = Customer.Value
SearchColumn = "Customer"
End If
If Location.Value <> "" Then
SearchTerm = Location.Value
SearchColumn = "Location"
End If
Results.Clear
' Only search in the relevant table column i.e. if somone is
searching Location
' only search in the Location column
With Range("Table1[" & SearchColumn & "]")
' Find the first match
Set RecordRange = .Find(SearchTerm, LookIn:=xlValues)
' If a match has been found
If Not RecordRange Is Nothing Then
FirstAddress = RecordRange.Address
RowCount = 0
Do
' Set the first cell in the row of the matching value
Set FirstCell = Range("B" & RecordRange.row)
' Add matching record to List Box
Results.AddItem
Results.List(RowCount, 0) = FirstCell(1, 1)
Results.List(RowCount, 1) = FirstCell(1, 2)
Results.List(RowCount, 2) = FirstCell(1, 3)
Results.List(RowCount, 3) = FirstCell(1, 4)
Results.List(RowCount, 4) = FirstCell(1, 5)
Results.List(RowCount, 5) = FirstCell(1, 7)
RowCount = RowCount + 1
' Look for next match
Set RecordRange = .FindNext(RecordRange)
' When no further matches are found, exit the sub
If RecordRange Is Nothing Then
Exit Sub
End If
' Keep looking while unique matches are found
Loop While RecordRange.Address <> FirstAddress
Else
' If you get here, no matches were found
Results.AddItem
Results.List(RowCount, 0) = "Nothing Found"
End If
End With
End Sub
Private Sub UserForm_Initialize()
FormEvents = True
End Sub
Add another column in the list box to hold the row number.
Results.List(RowCount, 6) = FirstCell.Row
And then code becomes
Private Sub PickBtn_Click()
Dim r as long
r = Results.List(Results.ListIndex,6)
Range(r, 7).Value = Date
End Sub
I am trying to create a form:
where you are able to select multiple items and it display in excel sheet
I was able to do so for selecting only one item in a list, but when changed to multi select I don't know how to link the form and the worksheet together.
Also - how do I make it display in the "database" portion of my form here:
code for Module 1
Option Explicit
Sub Reset()
Dim iRow As Long
iRow = [Counta(Database!A:A)] ' identifying the last row
With frmForm
.txtName.Value = ""
.txtAge.Value = "'"
.lstInvited.Clear
.lstInvited.AddItem "Aya"
.lstInvited.AddItem "Bi"
.lstInvited.AddItem "Britt"
.lstInvited.AddItem "Cami"
.lstInvited.AddItem "Sarl"
.lstInvited.AddItem "Ch"
.cmbTeacher.Clear
.cmbTeacher.AddItem "A"
.cmbTeacher.AddItem "Bia"
.cmbTeacher.AddItem "Cami"
.cmbTeacher.AddItem "China"
.cmbStudy.Clear
.cmbStudy.AddItem "1"
.cmbStudy.AddItem "2"
.cmbStudy.AddItem "3"
.cmbStudy.AddItem "45"
.lstAction.Clear
.lstAction.AddItem "Wants to study again"
.lstAction.AddItem "Other, Please specify in Notes"
.lstInfo.Clear
.lstInfo.AddItem "Open-minded"
.lstInfo.AddItem "Needs to study in a different language"
.lstInfo.AddItem "Other, Please specify in Notes"
.lstZoom.Clear
.lstZoom.AddItem "Attentive"
.lstZoom.AddItem "Not interactive/ Not connected"
.lstZoom.AddItem "Occupied"
.lstZoom.AddItem "Other, Please specify in Notes"
.txtNotes.Value = ""
.lstDatabase.ColumnCount = 10
.lstDatabase.ColumnHeads = True
If iRow > 1 Then
.lstDatabase.RowSource = "Database!A2:J" & iRow
Else
.lstDatabase.RowSource = "Database!A2:J2"
End If
End With
End Sub
Sub Submit()
Dim sh As Worksheet
Dim iRow As Long
Set sh = ThisWorkbook.Sheets("Database")
iRow = [Counta(Database!A:A)] + 1
With sh
.Cells(iRow, 1) = frmForm.txtName.Value
.Cells(iRow, 2) = frmForm.lstInvited.Value
.Cells(iRow, 3) = frmForm.txtAge.Value
.Cells(iRow, 4) = frmForm.cmbTeacher.Value
.Cells(iRow, 5) = frmForm.cmbStudy.Value
.Cells(iRow, 6) = frmForm.dtpDate.Value
.Cells(iRow, 7) = frmForm.lstAction.Value
.Cells(iRow, 8) = frmForm.lstInfo.Value
.Cells(iRow, 9) = frmForm.lstZoom.Value
.Cells(iRow, 10) = frmForm.txtNotes.Value
End With
End Sub
Sub Show_Form()
frmForm.Show
End Sub
`
and then here is the code for form (frmForm)
Private Sub cmdReset_Click()
Dim msgValue As VbMsgBoxResult
msgValue = MsgBox(" Do you want to reset the form?", vbYesNo + vbInformation, "Confirmation")
If msgValue = vbNo Then Exit Sub
Call Reset
End Sub
Private Sub cmdSave_Click()
Dim msgValue As VbMsgBoxResult
msgValue = MsgBox(" Do you want to save the data?", vbYesNo + vbInformation, "Confirmation")
If msgValue = vbNo Then Exit Sub
Call Submit
Call Reset
End Sub
Private Sub lstInvited_Initialize()
Me.lstInvited.RowSource = strInvitedList
End Sub
Private Sub lstAction_Initialize()
Me.lstAction.RowSource = strDVActionList
End Sub
Private Sub Frame1_Click()
End Sub
Private Sub lstAction_Click()
For i = 0 To lstAction.ListCount - 1
If lstAction.Selected(i) = True Then
ListBox2.AddItem
ListBox2.Column(0, (ListBox2.ListCount - 1)) = ListBox1.Column(0, i)
ListBox2.Column(1, (ListBox2.ListCount - 1)) = ListBox1.Column(1, i)
ListBox2.Column(2, (ListBox2.ListCount - 1)) = ListBox1.Column(2, i)
End If
Next
End Sub
Private Sub UserForm_Initialize()
Call Reset
End Sub
You'll need to loop through the list box. You can use the .ListCount property to get the number of rows (the index starts at 0 so use .ListCount - 1). You can check if the index is selected by using .Selected(i) where i is the loop counter.
So if your listbox is called ListBox1 you can do something like this to determine what rows are selected:
For i = 0 to ListBox1.Count - 1
If ListBox1.Selected(i) = True Then Debug.Print "Index " & i & " is selected"
Next i
Instead of the debug message you can add the information to your worksheet by using the listbox .List method, you'll need to use i for the row parameter and whatever number you need for the column parameter.
To add the information to the form you can use the .List method again to set those properties.
You may also want to look into assigning the values to an array as this would shorten your code.
As the title says, I have created a UserForm that adds data to a table but for some reason it does not add the data to the first empty row. In other words there will alway be an empty row at the top of my table and I can't for the life of me figure out what I'm doing wrong. I'm pretty new to this so there is obviously something I'm doing wrong, but what?
Would love some input on this!
Here is a link to the Excel file if you want to have a look (I made a separate tab in the file that explains the relationship between the Table and the different objects): https://files.fm/u/jguvasvq
If not, here's the code:
Private Sub button_leggtil_Click()
'Validation
If Me.data_foretak.Value = "" Then
MsgBox "Mangler Foretaksnavn."
End If
If Me.data_kontaktperson.Value = "" Then
MsgBox "Mangler Kontaktperson."
End If
If Me.data_telefonnummer.Value = "" Then
MsgBox "Mangler Telefonnummer."
End If
If VBA.IsNumeric(Me.data_telefonnummer.Value) = False Then
MsgBox "Ikke et gyldig telefonnummer."
Exit Sub
End If
If Me.data_epost.Value = "" Then
MsgBox "Mangler Epost."
End If
If Me.data_pris.Value = "" Then
MsgBox "Mangler Pris."
End If
If VBA.IsNumeric(Me.data_pris.Value) = False Then
MsgBox "Ikke gyldig pris format."
Exit Sub
End If
If Me.data_datotilb.Value = "" Then
MsgBox "Mangler dato - Tilbud."
End If
If VBA.IsDate(Me.data_datotilb.Value) = False Then
MsgBox "Feil dato format - Tilbud (Format: dd/mm/aa)."
Exit Sub
End If
If Me.data_datooppf.Value = "" Then
MsgBox "Mangler dato - Oppfølging."
End If
If VBA.IsDate(Me.data_datooppf.Value) = False Then
MsgBox "Feil dato format - Oppfølging (Format: dd/mm/aa)."
Exit Sub
End If
If Me.combo_sannsynlighet.Value = "" Then
MsgBox "Mangler Sannsynlighet."
End If
'Check for duplicate and insert data to table
Dim oNewRow As ListRow
Dim rng As Range
Set rng = ThisWorkbook.Worksheets("Tilbud").Range("TilbudTable")
rng.Select
Set oNewRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
If Application.WorksheetFunction.CountIf(rng, Me.data_foretak) > 0 Then
MsgBox "Denne bedriften finnes alerede i listen."
Exit Sub
End If
With ws
oNewRow.Range.Cells(1, 1).Value = Me.data_foretak
oNewRow.Range.Cells(1, 2).Value = Me.data_kontaktperson
oNewRow.Range.Cells(1, 3).Value = Me.data_telefonnummer
oNewRow.Range.Cells(1, 4).Value = Me.data_epost
oNewRow.Range.Cells(1, 5).Value = Me.data_pris
oNewRow.Range.Cells(1, 6).Value = Me.data_datotilb
oNewRow.Range.Cells(1, 7).Value = Me.data_datooppf
oNewRow.Range.Cells(1, 8).Value = Me.combo_sannsynlighet
End With
' Clear Input
Me.data_foretak.Value = ""
Me.data_kontaktperson.Value = ""
Me.data_telefonnummer.Value = ""
Me.data_epost.Value = ""
Me.data_pris.Value = ""
Me.data_datotilb.Value = ""
Me.data_datooppf.Value = ""
Me.combo_sannsynlighet.Value = ""
End Sub
-------------------------------------------------------------------------------------
Private Sub button_lukk_Click()
'Close form
Unload Me
End Sub
-------------------------------------------------------------------------------------
Private Sub button_tomskjema_Click()
'Clear Form
Me.data_foretak.Value = ""
Me.data_kontaktperson.Value = ""
Me.data_telefonnummer.Value = ""
Me.data_epost.Value = ""
Me.data_pris.Value = ""
Me.data_datotilb.Value = ""
Me.data_datooppf.Value = ""
Me.combo_sannsynlighet.Value = ""
End Sub
-------------------------------------------------------------------------------------
Private Sub UserForm_Activate()
With Me.combo_sannsynlighet
.Clear
.AddItem ""
.AddItem "10%"
.AddItem "20%"
.AddItem "30%"
.AddItem "40%"
.AddItem "50%"
.AddItem "60%"
.AddItem "70%"
.AddItem "80%"
.AddItem "90%"
.AddItem "100%"
End With
End Sub
I appreciate any input!
I find this code adds to a table called MyTable on Sheet1. If the table is empty, it adds as a first row.
Sub Test()
Dim tbl As ListObject
Set tbl = ThisWorkbook.Worksheets("Sheet1").ListObjects("MyTable")
With tbl.ListRows.Add
.Range(tbl.ListColumns("Heading 1").Index) = "Add data in column headed 'Heading 1'"
.Range(tbl.ListColumns("Heading 2").Index) = "Another named column."
.Range(3) = "Third column"
End With
End Sub
Edit - sorry, couldn't test on your code as it's not a Minimal, Reproducible Example - i.e. I couldn't easily copy it straight into my VBE to test.