I would like to also use text values to populate textbox one to four right now only number values will fetch data in the textbox, I know I am overlooking a pretty simple thing but can't seem to find out what?
Private Sub ComboBox1_Change()
Dim i As Long, LastRow As Long, ws As Worksheet
Set ws = Sheets("Sheet1")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Val(Me.ComboBox1.Value) = ws.Cells(i, "A") Then
MsgBox Me.ComboBox1.Value
Me.TextBox1 = ws.Cells(i, "B").Value
Me.TextBox2 = ws.Cells(i, "C").Value
Me.TextBox3 = ws.Cells(i, "D").Value
Me.TextBox4 = ws.Cells(i, "E").Value
End If
Next i
End Sub
I fixed it myself with the possibility to reverse it.
FYI: sheet is renamed to "Control"
Private Sub UserForm_Initialize()
With Sheets("Control")
Me.ComboBox1.List = .Range("a2", .Range("a" & Rows.Count).End(xlUp)).Value
End With
End Sub
Private Sub ComboBox1_Change()
Dim i As Long
For i = 1 To 4
Me("textbox" & i).Value = ""
Next
If Me.ComboBox1.ListIndex = -1 Then Exit Sub
With Sheets("control")
For i = 1 To 4
Me("textbox" & i).Value = .Cells(Me.ComboBox1.ListIndex + 2, i + 1).Value
Next
End With
End Sub
Private Sub CommandButton2_Click()
If Me.ComboBox1.ListIndex = -1 Then Exit Sub
Sheets("control").Cells(Me.ComboBox1.ListIndex + 2, "b").Resize(, 4).Value = _
Array(Me.TextBox1.Value, Me.TextBox2.Value, Me.TextBox3.Value, Me.TextBox4.Value)
End Sub
Related
I am creating an Excel userform in which users can add, search, and update records. I was able to create a button command that searches the database (a single sheet in my workbook) and populates a listbox with the search results. Because my database has more than 10 columns which I wanted to be visible in the listbox, I used an array to populate the listbox rather than AddItem which limited me to 10 or fewer columns. (the search code is below)
Private Sub Search_Click()
''''''''''''Validation
If Trim(SearchTextBox.Value) = "" And Me.Visible Then
MsgBox "Please enter a search value.", vbCritical, "Error"
Exit Sub
End If
ReDim arrs(0 To 17, 1 To 1)
With Worksheets("Sheet1")
ListBox.Clear
ListBox.ColumnCount = 18
ListBox.ColumnHeads = True
ListBox.Font.Size = 10
ListBox.ColumnWidths = "80,80,150,130,90,90,80,80,80,80,80,60,70,150,150,150,150,180"
If .FilterMode Then .ShowAllData
Set k = .Range("K2:K" & Cells(Rows.Count, "K").End(xlUp).Row).Find(What:="*" & SearchTextBox.Text & "*", LookIn:=xlValues, lookat:=xlWhole)
If Not k Is Nothing Then
adrs = k.Address
Do
M = M + 1
ReDim Preserve arrs(0 To 17, 1 To M)
For j = 0 To 17
arrs(j, M) = .Cells(k.Row, j + 1).Value
Next j
Set k = .Range("K2:K" & Cells(Rows.Count, "K").End(xlUp).Row).FindNext(k)
Loop While Not k Is Nothing And k.Address <> adrs
ListBox.Column = arrs
Else
' If you get here, no matches were found
MsgBox "No matches were found based on the search criteria.", vbInformation
End If
End With
End Sub
I also added code so that when I double click on a record in the listbox, it populates the corresponding textbox in the userform.
Private Sub ListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1.Text = ListBox.Column(0)
If TextBox1.Text = ListBox.Column(0) Then
TextBox1.Text = ListBox.Column(0)
TextBox2.Text = ListBox.Column(1)
TextBox3.Text = ListBox.Column(2)
TextBox4.Text = ListBox.Column(3)
TextBox5.Text = ListBox.Column(4)
TextBox6.Text = ListBox.Column(5)
TextBox7.Text = ListBox.Column(6)
TextBox8.Text = ListBox.Column(7)
TextBox9.Text = ListBox.Column(8)
TextBox10.Text = ListBox.Column(9)
TextBox11.Text = ListBox.Column(10)
TextBox12.Text = ListBox.Column(11)
TextBox13.Text = ListBox.Column(12)
TextBox14.Text = ListBox.Column(13)
TextBox15.Text = ListBox.Column(14)
TextBox16.Text = ListBox.Column(15)
TextBox17.Text = ListBox.Column(16)
TextBox18.Text = ListBox.Column(17)
End If
End Sub
After double clicking on a search result from the listbox, I want users to be able to edit any information in those textboxes and click a command button to update that entry/record in the database itself. However, I am having some problems with creating this function. I used the following code, and although it doesn't return an error message, it doesn't change the entry in the database.
Dim X As Long
Dim Y As Long
X = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For Y = 2 To X
If Sheets("Sheet1").Cells(Y, 11).Value = SearchTextBox.Text Then
Sheets("Sheet1").Cells(Y, 1).Value = TextBox1
Sheets("Sheet1").Cells(Y, 2).Value = TextBox2
Sheets("Sheet1").Cells(Y, 3).Value = TextBox3
Sheets("Sheet1").Cells(Y, 4).Value = TextBox4
Sheets("Sheet1").Cells(Y, 5).Value = TextBox5
Sheets("Sheet1").Cells(Y, 6).Value = TextBox6
Sheets("Sheet1").Cells(Y, 7).Value = TextBox7
Sheets("Sheet1").Cells(Y, 8).Value = TextBox8
Sheets("Sheet1").Cells(Y, 9).Value = TextBox9
Sheets("Sheet1").Cells(Y, 10).Value = TextBox10
Sheets("Sheet1").Cells(Y, 11).Value = TextBox11
Sheets("Sheet1").Cells(Y, 12).Value = TextBox12
Sheets("Sheet1").Cells(Y, 13).Value = TextBox13
Sheets("Sheet1").Cells(Y, 14).Value = TextBox14
Sheets("Sheet1").Cells(Y, 15).Value = TextBox15
Sheets("Sheet1").Cells(Y, 16).Value = TextBox16
Sheets("Sheet1").Cells(Y, 17).Value = TextBox17
Sheets("Sheet1").Cells(Y, 18).Value = TextBox18
End If
Next Y
Additionally, the term that I am searching with is not unique, so there are multiple records/rows in the database with the same search term. How can I create this code in a way that I when I click on the update button, information from the userform (which has been populated by doubleclicking the record in the listbox) is updated in the excel sheet but not for all records with the same search term?
Thank you so much for any help!
Add a Label to your UserForm to hold the row number from where the text box values came. Use the first column (width zero so hidden) of the listbox to hold the row number of the filtered rows. Set the label to column 0 of the double clicked row.
Option Explicit
Private Sub Update_Click()
Dim r As Long, n As Long
' record showing
r = Val(Label1.Caption)
If r < 1 Then
Exit Sub
End If
With Sheets("Sheet1")
For n = 1 To 18
.Cells(r, n).Value2 = Me.Controls("TextBox" & n)
Next
End With
End Sub
Private Sub ListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim n As Long
With ListBox
For n = 1 To ListBox.ColumnCount - 1
Debug.Print n, .Column(n)
Me.Controls("TextBox" & n).Text = .Column(n)
Next
Label1.Caption = .Column(0)
End With
End Sub
Private Sub Search_Click()
Const COLS = 18
Dim s
s = Trim(SearchTextBox.Value)
If s = "" And Me.Visible Then
MsgBox "Please enter a search value.", vbCritical, "Error"
Exit Sub
Else
s = "*" & s & "*"
End If
Dim rngFnd As Range, rngSearch As Range, first As String
Dim arr, lastrow As Long, i As Long, j As Long
' search sheet
With Worksheets("Sheet1")
If .FilterMode Then .ShowAllData
lastrow = .Cells(.Rows.Count, "K").End(xlUp).Row
Set rngSearch = .Range("K1:K" & lastrow)
i = WorksheetFunction.CountIf(rngSearch, s)
If i > 0 Then
ReDim arr(0 To COLS, 1 To i)
Set rngFnd = rngSearch.Find(What:=s, LookIn:=xlValues, lookat:=xlWhole)
If Not rngFnd Is Nothing Then
i = 0
first = rngFnd.Address
Do
i = i + 1
arr(0, i) = rngFnd.Row
For j = 1 To COLS
arr(j, i) = .Cells(rngFnd.Row, j).Value
Next j
Set rngFnd = rngSearch.FindNext(rngFnd)
Loop While rngFnd.Address <> first
End If
Else
'If you get here, no matches were found
MsgBox "No matches were found based on the search criteria. " & s, vbExclamation
Exit Sub
End If
End With
' format listbox
With ListBox
.Clear
.ColumnCount = COLS + 1
.ColumnHeads = True
.Font.Size = 10
.ColumnWidths = "0,80,80,150,130,90,90,80,80,80,80,80,60,70,150,150,150,150,180"
.Column = arr
End With
End Sub
I want to create a userform with inputs: Name (TextBox1), Surname (TextBox2), Date of birth (TextBox3) and 1 output which would basically be their ID (goes from 1 to inf). What bothers me is that I want to code that if lets say Name and Surname already exists in database, msg will popup and form will reset else everything will be put to the table. I kind of managed to do that. Problem is now if I do put name and surname that already exists it wont input it in the table and it will show the message, but even if it doesn't exists the message will still pop up but it will input it in the table. This is the code:
Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Sheet2
Dim a As Integer
Application.ScreenUpdating = False
iRow = ws.Range("A1048576").End(xlUp).Row + 1
If Not (TextBox1.Text = "" Or TextBox2.Text = "" Or TextBox3.Text = "") Then
With ws
Label1.Caption = iRow - 1
For a = 1 To iRow
If (ws.Cells(a, 2).Value = TextBox1.Value And ws.Cells(a, 3).Value = TextBox2.Value) Then
MsgBox "Values you entered already exists!"
Call Reset
Exit Sub
Else
.Range("A" & iRow).Value = Label1.Caption
.Range("B" & iRow).Value = TextBox1.Value
.Range("C" & iRow).Value = TextBox2.Value
.Range("D" & iRow).Value = TextBox3.Value
End If
Next a
End With
End If
Application.ScreenUpdating = True
End Sub
The problem is you are checking down to the row where the new record is inserted. So for every row that does not match the new record is inserted at iRow. When the loop gets to the end it checks iRow, matches and shows the message. Separate code into 2 steps, first check then update or reset.
Private Sub CommandButton1_Click()
If TextBox1.Text = "" Or TextBox2.Text = "" Or TextBox3.Text = "" Then
Exit Sub
End If
Dim ws As Worksheet
Dim iRow As Long, r As Long, bExists As Boolean
Set ws = Sheet2
iRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
' check exists
For r = 1 To iRow
If (ws.Cells(r, 2).Value = TextBox1.Value) _
And (ws.Cells(r, 3).Value = TextBox2.Value) Then
bExists = True
Exit For
End If
Next
' update sheet
If bExists Then
MsgBox "Values you entered already exists!"
Call Reset
Exit Sub
Else
Label1.Caption = iRow
iRow = iRow + 1
With ws
.Range("A" & iRow).Value = Label1.Caption
.Range("B" & iRow).Value = TextBox1.Value
.Range("C" & iRow).Value = TextBox2.Value
.Range("D" & iRow).Value = TextBox3.Value
End With
End If
End Sub
I am trying to create an input form in Excel that sets the values of cells in a row based on a number of Textboxes:
For each click of command button, update a new row of cells with the current form data.
Each textbox sets the value of a specific cell in the new row.
I managed to grind out something that works, but it seems clunky. I could end up with n amount of lines (potentially hundreds). It will be a pain to edit or troubleshoot.
I can't figure out how to refer each textbox to the correct cell in each new row.
How can I reduce this code from n number of lines, to a fixed number?
Private Sub CommandButton1_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim n As Long
Dim LastRow As Long
n = sh.Range("A" & Application.Rows.Count).End(xlUp).Row
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
sh.Range("A" & n + 1).Value = Me.TextBox1.Value
sh.Range("B" & n + 1).Value = Me.TextBox2.Value
sh.Range("C" & n + 1).Value = Me.TextBox3.Value
sh.Range("D" & n + 1).Value = Me.TextBox4.Value
sh.Range("E" & n + 1).Value = Me.TextBox5.Value
sh.Range("F" & n + 1).Value = Me.TextBox7.Value
sh.Range("G" & n + 1).Value = Me.TextBox8.Value
sh.Range("H" & n + 1).Value = Me.TextBox9.Value
sh.Range("I" & n + 1).Value = Me.TextBox10.Value
sh.Range("J" & n + 1).Value = Me.TextBox11.Value
End Sub
Maybe something along the lines of looping a pre-defined array:
Private Sub CommandButton1_Click()
Dim sh As Worksheet: Set sh = ThisWorkbook.Sheets("Sheet1")
Dim arr As Variant: arr = Evaluate("=""TextBox""&ROW(1:11)")
Dim lr As Long
With sh
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
For Each el In arr
.Cells(lr + 1, Replace(el, "TextBox", "") * 1) = Me.Controls(el).Value
Next
End With
End Sub
You could also decide to loop over all UserForm.Controls and check their TypeName property:
Private Sub CommandButton1_Click()
Dim sh As Worksheet: Set sh = ThisWorkbook.Sheets("Sheet1")
Dim ctrl As Control, lr As Long
With sh
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
For Each ctrl In Me.Controls
If TypeName(ctrl) = "TextBox" Then
.Cells(lr + 1, Replace(ctrl.Name, "TextBox", "") * 1) = ctrl.Value
End If
Next
End With
End Sub
But with this example you'd go over all controls and that might not be needed.
Hi I need to enter multiple rows of data at once based on the checkboxes that are selected. Currently this only adds 1 row. I think I have to use a loop but I'm not sure how I should implement it. Can anyone help please ?
The sample output should look something like this:
TC37 | 1
TC37 | 2
TC37 | 4
Current Code:
Dim LastRow As Long, ws As Worksheet
Private Sub CommandButton1_Click()
Set ws = Sheets("sheet1")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
ws.Range("A" & LastRow).Value = ComboBox1.Text
If CheckBox1.Value = True Then
ws.Range("B" & LastRow).Value = "1"
End If
If CheckBox2.Value = True Then
ws.Range("B" & LastRow).Value = "2"
End If
If CheckBox3.Value = True Then
ws.Range("B" & LastRow).Value = "3"
End If
If CheckBox4.Value = True Then
ws.Range("B" & LastRow).Value = "4"
End If
End Sub
Private Sub UserForm_Initialize()
ComboBox1.List = Array("TC37", "TC38", "TC39", "TC40")
End Sub
Since you are getting the last row 1 time, you should dump the data with reference to that one time. Try something like:
Dim chkCnt As Integer
Dim ctl As MSForms.Control, i As Integer, lr As Long
Dim cb As MSForms.CheckBox
With Me
'/* check if something is checked */
chkCnt = .CheckBox1.Value + .CheckBox2.Value + .CheckBox3.Value + .CheckBox4.Value
chkCnt = Abs(chkCnt)
'/* check if something is checked and selected */
If chkCnt <> 0 And .ComboBox1 <> "" Then
ReDim mval(1 To chkCnt, 1 To 2)
i = 1
'/* dump values to array */
For Each ctl In .Controls
If TypeOf ctl Is MSForms.CheckBox Then
Set cb = ctl
If cb Then
mval(i, 1) = .ComboBox1.Value
mval(i, 2) = cb.Caption
i = i + 1
End If
End If
Next
End If
End With
'/* dump array to sheet */
With Sheets("Sheet1") 'Sheet1
lr = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & lr).Resize(UBound(mval, 1), 2) = mval
End With
Problem is that your variable LastRow does not change. It is set only once at the beginning. So when you try to write the value, it will always write it to the same cell.
If CheckBox1.Value = True Then
LastRow = ws.Range("B100").end(xlup).Row + 1
ws.Range("B" & LastRow).Value = "1"
End If
If CheckBox2.Value = True Then
LastRow = ws.Range("B100").end(xlup).Row + 1
ws.Range("B" & LastRow).Value = "2"
End If
If CheckBox3.Value = True Then
LastRow = ws.Range("B100").end(xlup).Row + 1
ws.Range("B" & LastRow).Value = "3"
End If
If CheckBox4.Value = True Then
LastRow = ws.Range("B100").end(xlup).Row + 1
ws.Range("B" & LastRow).Value = "4"
End If
You could also use and array to store the values and then paste the result of the array in the range.
there are many ways to do this but this one should work. You should always clean the range prior to paste the values.
hope this helps,
I am new to VBA and coding in general. I am currently trying to transfer date from a multitab over to a workbook and keep getting the run time error 424: object required. Please help
Dim sheetname As String
Private Sub CommandButton2_Click()
Dim LastRow As Long
Dim sheetname As String
Select Case MultiPage1.Value
Case 0`sheetname = "Hannah"
Sheets(sheetname).Select
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A1").Select`enter code here`
Selection.End(xlDown).Offset(1, 0).Select
ActiveCell.Value = Date
ActiveCell.Offset(0, 1).Value = Me.RequestorHR.Value
ActiveCell.Offset(0, 2).Value = Me.CaseHR.Value
ActiveCell.Offset(0, 3).Value = Me.TypeHR.Value
ActiveCell.Offset(0, 4).Value = Me.UrgencyHR.Value
ActiveCell.Offset(0, 5).Value = Me.ReasonsHR.Value
ActiveCell.Offset(0, 6).Value = Me.DeadlineHR.Value
Clear_Click
Case 1
sheetname = "John"
Sheets(sheetname).Select
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("A1").Select
Selection.End(xlDown).Offset(1, 0).Select
ActiveCell.Value = Date
ActiveCell.Offset(0, 1).Value = Me.RequestorJM.Value
ActiveCell.Offset(0, 2).Value = Me.CaseJM.Value
ActiveCell.Offset(0, 3).Value = Me.TypeJM.Value
ActiveCell.Offset(0, 4).Value = Me.UrgencyJM.Value
ActiveCell.Offset(0, 5).Value = Me.ReasonsJM.Value
ActiveCell.Offset(0, 6).Value = Me.DeadlineJM.Value
Clear_Click
I made some suggestions below so you have less repeating code. I added an array so you do not have to keep retyping all your textbox(Assuming) values each time. I hope that helps. I had to guess so if it needs to be tweaked let me know bud! It may run an error cause i was not sure of the active cell your referring too. If you let me know, i can fix it.
Private Sub CommandButton2_Click()
Dim LastRow As Long
Dim sheetname As String
Dim strList() As Variant
Dim i As Integer
strList = Array(, Me.RequestorHR.Value, Me.CaseHR.Value, Me.TypeHR.Value, _
Me.UrgencyHR.Value, Me.ReasonsHR.Value, Me.DeadlineHR.Value)
Select Case MultiPage1.Value
Case 0
sheetname = "Hannah"
Sheets(sheetname).Select
LastRow = Sheets(sheetname).Range("A" & Rows.Count).End(xlUp).Row
Sheets(sheetname).Range("A1").End(xlDown).Offset(1, 0).Value = Date
For i = 1 To 6
With Sheets(sheetname)
.ActiveCell.Offset(0, i).Value = strList(i)
End With
Next i
Clear_Click
Case 1
sheetname = "John"
Sheets(sheetname).Select
LastRow = Sheets(sheetname).Range("A" & Rows.Count).End(xlUp).Row
Sheets(sheetname).Range("A1").End(xlDown).Offset(1, 0).Value = Date
For i = 1 To 6
With Sheets(sheetname)
.ActiveCell.Offset(0, i).Value = strList(i)
End With
Next i
Clear_Click
In Userform Code:
' StartUpPosition > Manual
Private Sub UserForm_Initialize()
With Me
.Top = Int(((Application.Height / 2) + Application.Top) - (.Height / 2))
.Left = Int(((Application.Width / 2) + Application.Left) - (.Width / 2))
End With
End sub
Code in worksheet or Module:
Sub Open_Userform
UserForm1.Show False
End sub
Have a great day!