I have these four values obtained from a userform.
With Worksheets("Sheet1)
Worksheets("Sheet1").Range("A2").value = TextBox1.Value
Worksheets("Sheet1").Range("B2").value = ListBox1.Value
Worksheets("Sheet1").Range("C2").value = TextBox2.Value
Worksheets("Sheet1").Range("D2").value = ListBoxw.Value
End with
But I want to paste in the next available row instead of just replacing the data in row 2. How can I make it dynamic like that? Do I need to count the number of items already there? So if the user opens the form again, the previously entered data is still there and we just add on. Also, how could I put the current date as the default value in TextBox1?
In order to paste the values to the last empty row, use the next code:
Sub PasteBelowTheLastRow()
Dim lastEmptyRow As Long, sh As Worksheet
Set sh = ActiveWorkbook.Sheets("Sheet1")
lastEmptyRow = sh.Range("A:A").End(xlUp).Row + 1
With sh
.Range("A" & lastEmptyRow).value = TextBox1.value
.Range("B" & lastEmptyRow).value = ListBox1.value
.Range("C" & lastEmptyRow).value = TextBox2.value
.Range("D" & lastEmptyRow).value = ListBox2.value
End With
End Sub
In order to automatically set the current data in TextBox1 you must have the next code in the UserForm_Initialize() event:
Private Sub UserForm_Initialize()
Me.TextBox1.value = Date
End Sub
Related
I am trying to create a tool with a userform where the user types a Model in a textbox and selects all the countries where this Model comes from in 10 possible checkboxes.
This information is transferred to "Country" Worksheet through command button.
My code places textbox value in column A and country name from checkbox label in column B.
The problem is that I have more than one country for the same model so I'm getting blank cells without matching Model.
E.g. "Type A" belongs to USA, Brazil, Sweden and Mexico, so I should have "Type A" copied four times along country names instead of just one.
Private sub Transfer()
Dim i As Long
Dim aCol As Range
Dim BS As Worksheet
Set aCol = Worksheets("Country").Range("A:A")
Set BS = Worksheets("Country")
For i = 1 To 10
With Me.Controls("CheckBox" & i)
If .Value Then
aCol.Cells(82, 2).End(xlUp).Offset(1, 0).Value = .Caption
End If
End With
Next i
Dim b As Integer
b = 1
Do Until BS.Range("A" & b).Value = ""
b = b + 1
end sub
With the code you shared and without major changes, I would suggest you to think about writing the info contained in the textbox within the loop of the checkboxes and right after the if. This way you will be adding the textbox text no matter what avoiding the blanks
If .Value Then
aCol.Cells(82, 1).End(xlUp).Offset(1, 0).Value = Me.Controls("TextBox1").Text
aCol.Cells(82, 2).End(xlUp).Offset(1, 0).Value = .Caption
End If
Let me know if that works, below the full code I used to replicate your issue:
Private Sub CommandButton1_Click()
Call Transfer
End Sub
Private Sub Transfer()
Dim i As Long
Dim aCol As Range
Dim BS As Worksheet
Set aCol = Worksheets("Country").Range("A:A")
Set BS = Worksheets("Country")
For i = 1 To 3
With Me.Controls("CheckBox" & i)
If .Value Then
aCol.Cells(82, 1).End(xlUp).Offset(1, 0).Value = Me.Controls("TextBox1").Text
aCol.Cells(82, 2).End(xlUp).Offset(1, 0).Value = .Caption
End If
End With
Next i
End Sub
How the form I did looks in VBA
How the results look like in the file
I am facing a problem in getting the sequence of the unique numbers(Serial number) when the userform is closed and opened later on. Firstly, when I fill the data in the userform everything is captured in the excel sheet perfectly with correct sequence; if I close the userform and run the code by filling the userform with new data the unique ID's are again starting from "1" but not according to the excel sheet row number which was previously saved.
Below is the code I tried:
Private Sub cmdSubmit_Click()
Dim WB As Workbook
Dim lr As Long
Set WB = Workbooks.Open("C:\Users\Desktop\Book2.xlsx")
Dim Database As Worksheet
Set Database = WB.Worksheets("Sheet1")
eRow = Database.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
lr = Database.Range("a65536").End(xlUp).Row
With Sheets("Sheet1")
If IsEmpty(.Range("A1")) Then
.Range("A1").Value = 0
Else
Database.Cells(lr + 1, 1) = Val(Database.Cells(lr, 1)) + 1
End If
End With
Database.Cells(eRow, 4).Value = cmbls.Text
Database.Cells(eRow, 2).Value = txtProject.Text
Database.Cells(eRow, 3).Value = txtEovia.Text
Database.Cells(eRow, 1).Value = txtUid.Text
Call UserForm_Initialize
WB.SaveAs ("C:\Users\Desktop\Book2.xlsx")
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim maxNumber
If Not Intersect(Target, Range("B:B")) Is Nothing Then
' don't run when more than one row is changed
If Target.Rows.Count > 1 Then Exit Sub
' if column A in the current row has a value, don't run
If Cells(Target.Row, 1) > 0 Then Exit Sub
' get the highest number in column A, then add 1 and write to the
' current row, column A
maxNumber = Application.WorksheetFunction.Max(Range("A:A"))
Target.Offset(0, -1) = maxNumber + 1
End If
End Sub
Private Sub UserForm_Initialize()
With txtUid
.Value = Format(Val(Cells(Rows.Count, 1).End(xlUp)) + 1, "0000")
.Enabled = False
End With
With txtProject
.Value = ""
.SetFocus
End With
End Sub
In this image if you see unique id's are repeating 1 and 2, but I need as 1,2,3,4....
I think this is where the issue is coming from. You need to re-calculate the last row every time the user form is Initialized.
Private Sub UserForm_Initialize()
Dim ws as Worksheet: Set ws = Thisworkbook.Sheets("Database")
With txtUid
.Value = Format(ws.Range("A" & ws.Rows.Count).End(xlUp) + 1, "0000")
.Enabled = False
End With
With txtProject
.Value = ""
.SetFocus
End With
End Sub
It's always risky to use row numbers or [max range value +1] as a sequence number.
Safer to use something like a name scoped to the worksheet, which has a value you can increment. Then the sequence is independent of your data.
E.g.
Function GetNextSequence(sht As Worksheet) As Long
Const SEQ_NAME As String = "SEQ"
Dim nm As Name, rv As Long
On Error Resume Next
Set nm = sht.Names(SEQ_NAME)
On Error GoTo 0
'add the name if it doesn't exist
If nm Is Nothing Then
Set nm = sht.Names.Add(Name:=SEQ_NAME, RefersToR1C1:="=0")
End If
rv = Evaluate(nm.Value) + 1
nm.Value = rv
GetNextSequence = rv
End Function
Part 1: A combo box in sheet1 to dynamically list unique values from a column in sheet2 put it in the drop down list
Part 2: Display the related entries of sheet2 in sheet1 based on the combo box selection.
I have done the part 1 in a method call fillCombo and have called it under ComboBox1_DropButtonClick() and part 2 under the method ComboBox1_Change()
First time when i click dropdown arrow of combo box it lists the unique entries and on making the selection in it, the related entries are displayed in sheet1 and everything is fine.
During the next selection of dropdown arrow it goes to ComboBox1_DropButtonclick() method then ComboBox1_change() method, ComboBox1_change() method without the dropdown list appearing and me selecting
So it works correctly only in the first instance.
Can you please correct the error.
Private Sub ComboBox1_Change()
Dim sht2, sht1, a As Long, X As Long, i As Long
Dim Lastrow As Long
Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")
a = sht2.Cells(Rows.Count, 1).End(xlUp).Row
X = 8
Lastrow = sht1.Range("D" & Rows.Count).End(xlUp).Row
sht1.Range("G8:J" & Lastrow).Clear
For i = 2 To a
If sht2.Cells(i, 3).Value = "Payments" Then
sht2.Cells(i, "C").Resize(1, 4).Copy sht1.Cells(X, "G")
X = X + 1
End If
Next
sht1.Select
sht1.Cells(1, 1).Select
End Sub
Private Sub ComboBox1_DropButtonClick()
Call fillCombo
End Sub
Sub fillCombo()
Dim ws2 As Worksheet
Set ws2 = ThisWorkbook.Sheets("Sheet2")
Group = 3
firstTime = True
strValue = Sheet1.ComboBox1.Value
'last row
wsLR = ws2.Cells(Rows.Count, 1).End(xlUp).Row
'loop thru rows
For l = 2 To wsLR
If ws2.Cells(l, Group) <> "" And (InStr(uE, "|" & ws2.Cells(l, Group) & "|") = 0) Then
If firstTime = True Then
firstTime = False
uE = "|" & uE & ws2.Cells(l, Group) & "|"
Else
uE = uE & ws2.Cells(l, Group) & "|"
End If
End If
Next l
dropValues = Split(uE, "|")
Sheet1.ComboBox1.Clear
For Each cell In dropValues
If cell <> "" Then
Sheet1.ComboBox1.AddItem cell
End If
Next cell
Sheet1.ComboBox1.Value = strValue
End Sub
Hi there,
Thanks to you for your support I got recently. I am working with a excel sheet (image is attached here), here I have approx 60k rows repeating same date in column A. Actually what I need to do is to select start date & end date through user form (can see in image). when will click on OK button rest rows having dates out of given date range should be deleted.
but my code is not working exactly as I want & deleting some of rows which is within the range. I accept there may be my mistakes but after so many efforts I couldn't find out. And also dates in combo box is repeating so many times & not sorted. pls go thorough my codes below -
Private Sub CancelButton_Click()
Unload UserForm1
End Sub
Private Sub ComboBox1_Change()
ComboBox1.Value = Format(ComboBox1.Value, "dd-mmm-yyyy")
End Sub
Private Sub ComboBox2_Change()
ComboBox2.Value = Format(ComboBox2.Value, "dd-mmm-yyyy")
End Sub
Private Sub okButton_Click()
Dim i As Double, dt1 As String, dtt1 As String
Dim dt2 As String, dtt2 As String
Dim ws As Worksheet, lRow As Long
Set ws = ActiveWorkbook.Sheets(1)
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
dt1 = ComboBox1.Value
dtt1 = CDate(dt1)
dt2 = ComboBox2.Value
dtt2 = CDate(dt2)
Application.ScreenUpdating = False
For i = 2 To lRow
If Range("A" & i).Value >= dtt1 And Range("A" & i).Value <= dtt2 Then
Rows(i).Select
Selection.Delete
i = i - 1
End If
Next
Application.ScreenUpdating = True
Unload UserForm1
End Sub
Private Sub UserForm_Initialize()
Set ws = ActiveWorkbook.Sheets(1)
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
ComboBox1.RowSource = "A2:A" & lRow
ComboBox2.RowSource = "A2:A" & lRow
End Sub
Thanks a lot in advance.
Instead of
For i = 2 To lRow
try
For i = lRow To 2 step -1
Please note: I didn't check the rest of your code because probably this is the problem; when you want to delete rows (or columns) on a spreadsheet by VBA, is always a good procedure doing it from bottom to top (or right to left if you're dealing with columns).
Good day guys I created a userform on excel with a combobox and a command button, the command button is for updating the data on the spread sheet based on the item selected on the combobox and a textbox with data, the problem is every time I click the command button it does not update the data, instead it goes to the next column and fill it in. and i want the data to be updated on the item selected
this is what I tried
Private Sub CommandButton6_Click()
Dim lrCD As Long
lrCD = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet2").Cells(lrCD + 1, "A").Value = ComboBox1.Text
Sheets("Sheet2").Cells(lrCD + 1, "B").Value = TextBox5.Text
Create your form as below:
Column A in Sheet2 contains unique values that will appear in your combobox.
This code sits within the form.
The UserForm_Initialize() event fires when you open the form and will populate the combobox with values.
The CommandButton6_Click event searches column A and places the text in textbox5 next to the selected value.
Private Sub UserForm_Initialize()
Dim lrCD As Long
'Populate ComboBox with values from column A on Sheet2.
With ThisWorkbook.Worksheets("Sheet2")
lrCD = .Range("A" & Rows.Count).End(xlUp).Row
Me.ComboBox1.RowSource = "'Sheet2'!" & .Range(.Cells(1, 1), .Cells(lrCD, 1)).Address
End With
End Sub
Private Sub CommandButton6_Click()
Dim rCell As Range
With ThisWorkbook.Worksheets("Sheet2")
'Look for the selected value in column A.
Set rCell = .Columns(1).Find( _
What:=Me.ComboBox1.Value, _
After:=.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole)
'If a value is found place the textbox value in the column next to it.
If Not rCell Is Nothing Then
rCell.Offset(, 1) = Me.TextBox5.Value
End If
End With
End Sub