I need your help. It seems what I have written in code does not accomplish what I am trying to do here.
The objective would be to have 2 userform combo boxes one for the (floor) values which are manually added once [3,4,5] and the other combo boxes (offices) in which values are dynamically added based on the selection made in the floor selection box.
Let's say for example that if I chose the value [3] in my floor combo box that the office combo box would contain the following values:
A-01
A-02
A-03
A-04
A-05
A-06
A-07
A-08
I thought this code would work but it doesn't:
'Cells(row, col)
Private Sub floor_Change()
lRow = Sheets("Office Spaces").UsedRange.Rows.Count
With Sheets("Office Spaces")
For i = 2 To lRow
If .Cells(i, 1).Value = UserForm1.floor.Value Then
UserForm1.office.AddItem .Cells(i, 2).Value
End If
Next i
End With
End Sub
Here's what the data looks in my excel sheet:
'Cells(row, col)
Private Sub floor56_Change()
UserForm1.office.Clear
Dim sh
Dim rw
Set sh = Sheets("Office Spaces")
For Each rw In sh.Rows
If sh.Cells(rw.row, 1).Text = UserForm1.floor.Value Then
UserForm1.office.AddItem (sh.Cells(rw.row, 2).Value)
End If
Next rw
End Sub
or
Private Sub floor_Change()
If UserForm1.floor.Value <> "" Then
UserForm1.office.Clear
Dim ws
Set ws = ThisWorkbook.Worksheets("Office Spaces")
Dim rng
Set rng = ws.Range("A:A")
For Each cell In rng
If cell.Text = UserForm1.floor.Value Then
UserForm1.office.AddItem (cell.Offset(0, 1).Value)
End If
Next cell
End If
End Sub
Related
I have a simple Userform with two textboxes. User is to enter Part Description in one labelled "Panel ID" and the number of rows that description is to be entered in the same column of the spreadsheet (Quantity). By now, I am OK with adding value in empty row, but got stuck at copying the value to other cells. I have code for copying the value in set range, but cannot find anything that works for what I am looking for. Thanks
Apples Oranges List
Private Sub SubmitBtn_Click()
Dim iRow As Long, C As Long
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Data")
iRow = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
C = QTYBox.Value
With sh
.Cells(iRow, 1) = TxtPanel.Value
End With
End Sub
Private Sub UserForm_Initialize()
'Empty Panel ID cell
TxtPanel.Value = ""
'Empty Quantity cell
QTYBox.Value = ""
'Set focus to panel ID cell
TxtPanel.SetFocus
End Sub
This is code for second problem:
crate form
crate spreadsheet
Private Sub SubmitBtn_Click()
Dim i As Long
Dim sh As Worksheet
Dim lRow As Long
Set sh = ThisWorkbook.Sheets("Data")
lRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
With sh
For i = 2 To lRow
'Criteria search
If .Cells(i, 1).Value = PanelTxt.Value Then
If .Cells(i, 2).Value = IDTxt.Value Then
'Enter date in Crated and Crate #
.Cells(i, 5) = [Text(Now(), "DD-MM-YY HH:MM")]
.Cells(i, 6) = CrateTxt.Value
Exit For
End If
End If
Next
End With
End Sub
I am new to Excel-VBA and I'm trying to add items in combo box depending on the cell color.
In this example, I only want the text of those blue shades be added on the combobox list.
Sheets("Application").ComboBox1.List = Range("A:A").Value
This code will go through out column A and if it finds a cell with specific color, it will add it to the combobox, this will occurred every time the sheet gets activated.
Option Explicit
Private Sub Worksheet_Activate()
Dim rng As Range
Dim i As Long
Dim LastRow As Long
Me.ComboBox1.Clear
With Sheets("Application")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
If .Cells(i, 1) <> vbNullString Then
If Cells(i, 1).Interior.Color = 12611584 Then
Me.ComboBox1.AddItem Cells(i, 1)
End If
End If
Next
End With
End Sub
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
I am working on a sheet that have day to day sales data. I need to summaries the data between a specific date. for this I want to use a user form with 2 combo box (I have never worked with user forms & controls ever before). I added the items into combo box by using below codes -
Private Sub UserForm_Initialize()
ComboBox1.RowSource = "A2:A6724"
ComboBox2.RowSource = "A2:A6724"
End Sub
this worked fine. But here is a problem that it is repeating the same items many time as there are many transactions in same date in the sheet.
To solve this issue I search help in internet & found a procedure, I modify that and used in my code. that's working correctly but it also has a little problem that as I click on a date from drop down list of combo box it changes the date format (i.e. if I select 10/12/2016 it shows 12-oct-2016 but it should be 10-dec-2016)
here is the code I modify actually I don't know what it does but I think is will work for me-
Private Sub UserForm_Initialize()
'ComboBox1.RowSource = "A2:A6724"
'ComboBox2.RowSource = "A2:A6724"
Dim Coll As Collection, cell As Range, LastRow As Long
Dim blnUnsorted As Boolean, i As Integer, temp As Variant
Dim SourceSheet As Worksheet
Set SourceSheet = Worksheets("Sheet1")
LastRow = SourceSheet.Cells(Rows.Count, 1).End(xlUp).Row
On Error Resume Next
Set Coll = New Collection
With ComboBox1
.Clear
For Each cell In SourceSheet.Range("A2:A" & LastRow)
If Len(cell.Value) <> 0 Then
Err.Clear
Coll.Add cell.Text, cell.Text
If Err.Number = 0 Then .AddItem cell.Text
End If
Next cell
End With
Set SourceSheet = Worksheets("Sheet1")
LastRow = SourceSheet.Cells(Rows.Count, 1).End(xlUp).Row
On Error Resume Next
Set Coll = New Collection
With ComboBox2
.Clear
For Each cell In SourceSheet.Range("A2:A" & LastRow)
If Len(cell.Value) <> 0 Then
Err.Clear
Coll.Add cell.Text, cell.Text
If Err.Number = 0 Then .AddItem cell.Text
End If
Next cell
End With
Set Coll = Nothing
Set SourceSheet = Nothing
End Sub
I will be greatly Thankful for any help.
Try following code, that use a dictionary.
Public dU1 As Object, cU1 As Variant, iU1 As Long, lrU As Long
Private Sub UserForm_Initialize()
Dim i As Integer
Set dU1 = CreateObject("Scripting.Dictionary")
lrU = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
cU1 = Worksheets("Sheet1").Range("A2:A" & lrU) 'Starts in second row. First row left for titles
For iU1 = 1 To UBound(cU1, 1)
dU1(cU1(iU1, 1)) = 1
Next iU1
'now dU1 has unique values from column A
For i = 0 To dU1.Count - 1
ComboBox1.AddItem dU1.Keys()(i) 'Load Combobox1 with unique values from Column A
Next
End Sub
Private Sub ComboBox1_Change()
Dim lLastRow As Long
Dim i As Integer
ComboBox2.Clear
For i = 0 To dU1.Count - 1
If CDate(ComboBox1.Value) < CDate(dU1.Keys()(i)) Then
ComboBox2.AddItem dU1.Keys()(i) 'Load Combobox2
End If
Next
End Sub