I have a form that with a lot of data validation. The form can be saved.
In the last update I added an ActiveX Combobox. People can choose from different license plates and it auto-fills so fewer errors are made.
I want the value filled in the combobox to be saved and the combobox field to be empty when the 'save button' is pressed.
This is the code I currently have:
Sub Store_Data()
'Takes data from one worksheet and stores it in the next empty row
Dim sourceSheet As Worksheet
Dim dataSheet As Worksheet
Dim nextRow As Integer
Dim xCombox As OLEObject --- Not sure this is correct
Set sourceSheet = Sheets("Départ")
Set dataSheet = Sheets("Data Départ")
Set xCombox = sourceSheet.OLEObjects("TempCombo") '--- not sure this is correct
'A is the colums is that will always be there; here it is matricule - unique data
nextRow = dataSheet.Range("A" & dataSheet.Rows.Count).End(xlUp).Offset(1).Row
dataSheet.Cells(nextRow, 1).Value = sourceSheet.Range("F4").Value
dataSheet.Cells(nextRow, 2).Value = sourceSheet.Range("F6").Value
dataSheet.Cells(nextRow, 3).Value = sourceSheet.Range("F8").Value
' ---- I used LinkedCell and then use the value of this cell to add to my database,
' because I have no idea how to retrieve data from the combobox directly.
dataSheet.Cells(nextRow, 4).Value = sourceSheet.Range("L10").Value
dataSheet.Cells(nextRow, 5).Value = sourceSheet.Range("F12").Value
dataSheet.Cells(nextRow, 6).Value = sourceSheet.Range("F14").Value
dataSheet.Cells(nextRow, 7).Value = sourceSheet.Range("F16").Value
dataSheet.Cells(nextRow, 8).Value = Format(Now, "HH:mm:ss")
'Clear Data
sourceSheet.Range("F4").Value = ""
sourceSheet.Range("F8").Value = ""
sourceSheet.Shapes.Range(Array("TempCombo")).Clear '----- This one gives an error
sourceSheet.Range("F12").Value = ""
sourceSheet.Range("F14").Value = ""
sourceSheet.Range("F16").Value = ""
ActiveWorkbook.Save
End Sub
Most of these codes I retrieved from the internet.
This is how the combobox looks and is named. (My Excel is in Dutch).
Related
I have an excel file automated with a macro. I have a userform interface (see photo below). Inside the userform is a combobox and a textbox.
I want to add something in the worksheet but depending on what type of expenses it is and I don't understand what is wrong in my code below. What I want is if I add something in the column of "taxi" (2nd row), I can also in "carwash" (2nd row) but it appears to a different result. I am also not able to add data on 3rd, 4th, 5th rows and so on.
Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
'find first empty row in database
Set rngNullString = Intersect(ws.Columns("A"), ws.Columns("A")).Find("")
If rngNullString.row < ws.Cells(ws.Rows.Count, "A").End(xlUp).row Then
Set rngNullString = Intersect(ws.Columns("A"), _
ws.Columns("A")).SpecialCells(xlCellTypeBlanks)
End If
iRow = rngNullString.row
'check for Name number
If Trim(Me.TextBox1.value) = "" Then
Me.TextBox1.SetFocus
MsgBox "Please complete the FORM"
Exit Sub
End If
'copy the data to the database
If Me.ComboBox1.value = "Taxi" Then
ws.Cells(iRow, 1).value = Me.ComboBox1.value
ws.Cells(iRow, 2).value = Me.TextBox1.value
End If
If Me.ComboBox1.value = "Carwash" Then
ws.Cells(iRow, 3).value = Me.ComboBox1.value
ws.Cells(iRow, 4).value = Me.TextBox1.value
End If
MsgBox "Sucessfully! Data added", vbOKOnly + vbInformation, "Data Notification"
'clear the data
Me.TextBox1.value = ""
Me.ComboBox1.value = ""
Me.TextBox1.SetFocus
Unload Me
End Sub
I have a userform with combobox 9 when you select combobox9 value it will show all the values into the each boxes and you can updated the textbox 19 value into sheet against the raw of the selected value in combobox9 however problem is if there's the same name e.g. twice same name in combobox9 it will only update the its 1st name on the raw and not the 2nd or even if there is 3 entry in sheet with same name.
Names are in column C and textvalue is updated its name on column H however I need to loop the column H if it is already updated against its name then same name needs to updated which is in new raw.
Below is the vba code I have but it is so far not working
Dim lCol As Variant
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Attendance")
If Me.ComboBox9.Value <> "" Then
If VBA.CVar(Application.Match(VBA.CVar(Me.ComboBox9.Value), sh.Range("C:C"), 0)) = True Then
MsgBox "Record Not found", vbCritical
Exit Sub
Else
i = Application.Match(VBA.Cvar(Me.ComboBox9.Value), sh.Range("C:C"), 0)
End If
lCol = Me.ComboBox9.Value
Set findvalue = sh.Range("C:C").Find(What:=lCol, LookIn:=xlValues)
If Not findvalue Is Nothing Then
adr = findvalue.Address
Do
If findvalue.Offset(0, 6).Value = Me.TextBox19 Then
sh.Unprotect "1234"
findvalue.Offset(0, 6).Value = Me.TextBox19.Value = ""
Exit Do
End If
Set findvalue = sh.Range("C:C").FindNext(findvalue)
Loop While findvalue.Address <> adr
Set findvalue = Nothing
End If
I want to paste certain rows into a certain sheet if a string is entered into a textbox.
I have is a userform that I'd like to paste entries into Month specific sheets based on the date textbox.
I can copy to one specific sheet, but I'd like to auto sort into the appropriate Month sheet based on the value entered in DT.value.
Private Sub Submit_Click()
Dim ws As Worksheet
Dim LastRow As Long
If DT.Value = "nov" Then
Set ws = ThisWorkbook.Worksheets("NOV")
Else
If DT.Value = "dec" Then
Set ws = ThisWorkbook.Worksheets("DEC")
Else
If DT.Value = "Jan" Then
Set ws = ThisWorkbook.Worksheets("JAN")
Else
If DT.Value = "Feb" Then
Set ws = ThisWorkbook.Worksheets("FEB")
Else
If DT.Value = "mar" Then
Set ws = ThisWorkbook.Worksheets("MAR")
Else
If DT.Value = "Apr" Then
Set ws = ThisWorkbook.Worksheets("APR")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
'other code that works below.
With this code I end up with Type Mismatch or nothing gets copied.
I'd like the user to enter a date in the dt.value box and the data paste to the appropriate sheet based on that value.
It depends on how you have named your tabs and how your date is imputed in the textbox.
But if you are using mar and MAR, here is a simple code to assign the worksheet variable using the text in the userform textbox.
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(Me.DT.Text)
Update to basic code:
Private Sub CommandButton1_Click()
'Check if the textbox has a valid date
If IsDate(Me.DT.Text) Then
Me.DT.Text = Format(CDate(Me.DT.Text), "mmm") 'Format as abrivated month
'Define and Assign worksheet and newRow variables
Dim ws As Worksheet, newRow As Long
Set ws = ThisWorkbook.Worksheets(Me.DT.Text)
newRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
With ws 'When writing other textbox values to the worksheet; change TextBox# as required
.Cells(newRow, 1).Value = Me.TextBox1.Text
.Cells(newRow, 2).Value = Me.TextBox2.Text
.Cells(newRow, 3).Value = Me.TextBox3.Text
.Cells(newRow, 4).Value = Me.TextBox4.Text
End With
Application.Goto ws.Range("A1"), Scroll:=True 'Set the focus to the first cell on the worksheet
Else 'If a valid date is not entered display a message box
MsgBox "Please enter a valid date"
Cancel = True
End If
End Sub
I have the following code on a command button that initializes in a Listbox on a Userform and pastes the value into "ThisWorkbook.Worksheets("Sub")".
This only works with one selection, and if you select multiple selections in the Listbox it will only add the first value to cell A8 in column 5.
I want user to be able to pick several options from a listbox. Then, when they save the form, I want the options they selected to populate in the next available row as an Array in the Excel sheet:
Private Sub cmdadd_Click()
On Error Resume Next
Set wks = ThisWorkbook.Worksheets("Sub")
wks.Activate
Dim i As Integer
ActiveSheet.Range("A8").Select
i = 1
Do Until ActiveCell.Value = Empty
ActiveCell.Offset(1, 0).Select 'move down 1 row
i = i + 1 'keep a count of the ID for later use
Loop
'Populate the new data values into the 'Sub' worksheet.
ActiveCell.Value = i 'Next ID number
'Populate the new data values into the 'Sub' worksheet.
ActiveCell.Offset(0, 1).Value = Me.txtls.Text 'set col B
ActiveCell.Offset(0, 2).Value = Me.txtPr.Text
ActiveCell.Offset(0, 3).Value = Me.cbolo.Text
Dim intOffset As Integer
Dim strVal As String
Dim selRange As Range
Set selRange = Selection
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
If strApps = "" Then
strApps = ListBox1.List(i)
intOffset = i
strVal = ActiveCell.Offset(0, 4).Value 'set col E
Else
strApps = strApps & ";" & ListBox1.List(i)
intOffset = i
strVal = strVal & ";" & ActiveCell.Offset(0, 4).Value 'set col E
End If
End If
Next
End Sub
Private Sub UserForm_Initialize()
Me.ListBox1.AddItem "A"
Me.ListBox1.AddItem "3"
Me.ListBox1.AddItem "S"
Me.ListBox1.AddItem "2"
Me.ListBox1.AddItem "S"
End Sub
Avoid Select/Active/Selection/ActiveXXX coding pattern and rely on fully qualified (uop to worksheet, at least) range references
as follows
Option Explicit
Private Sub cmdadd_Click()
Dim wks As Worksheet
Set wks = ThisWorkbook.Worksheets("Sub")
Dim i As Long
With wks.Range("A8") ' reference "sub" worksheet cell A8
i = 1
Do Until .Offset(i - 1).Value = Empty ' check for referenced cell current row offset empty value
i = i + 1 'keep a count of the ID for later use
Loop
'Populate the new data values into the 'Sub' worksheet.
With .Offset(i - 1) ' reference referenced cell row offset to first empty cell
'Populate the new data values into the 'Sub' worksheet.
.Value = i ' set col A with next ID number
.Offset(0, 1).Value = Me.txtls.Text 'set col B
.Offset(0, 2).Value = Me.txtPr.Text 'set col C
.Offset(0, 3).Value = Me.cbolo.Text 'set col D
Dim strApps As String
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then strApps = strApps & ListBox1.List(i) & ", " ' update 'strApps' string with listbox selected items separated by a comma and a space
Next
If strApps <> "" Then .Offset(0, 4).Value = Left(strApps, Len(strApps) - 2) ' if any listbox selected values, write 'strApps' in col E
End With
End With
End Sub
I created a userform that will autofill in all the information using the ID# but I cant pull the source from the specific folder, workbook and range.
Here is my code:
Private Sub TextBox4_Change()
Dim rSource As Range
If Not r Is Nothing Then
'// Get value in cell r.row, column 2 into textbox2
TextBox2.Text = Sheet1.Cells(r.Row, 4).Value
ComboBox3.Value = Sheet1.Cells(r.Row, 6).Value
ComboBox4.Value = Sheet1.Cells(r.Row, 8).Value
ComboBox5.Value = Sheet1.Cells(r.Row, 9).Value
End If
End sub
Thank you!
See my answer in the code below (explanation inside the code as comments):
Option Explicit
Private Sub TextBox4_Change()
Dim wb As Workbook
Dim rSource As Range
' === first set the Workbook object ===
' if the workbook (Excel file) is already open >> use the line below
Set wb = Workbooks("Request ID.xlsm")
' if its close, then use the alternative line below
Set wb = Workbooks.Open("\\Path\")
' now use the Find function
Set rSource = wb.Worksheets("Sheet1").Range("A:A").Find(What:=TextBox4.Text, LookAt:=xlWhole, MatchCase:=False)
If Not rSource Is Nothing Then '<-- you need to use the same Range variable you used for the Find
'// Get value in cell r.row, column 2 into textbox2
TextBox2.Text = Sheet1.Cells(rSource.Row, 4).Value
ComboBox3.Value = Sheet1.Cells(rSource.Row, 6).Value
ComboBox4.Value = Sheet1.Cells(rSource.Row, 8).Value
ComboBox5.Value = Sheet1.Cells(rSource.Row, 9).Value
End If
End Sub