here I have serial number in textbox (txt_Rec) from worksheet("Sale") lastrow.
Now i want to get conditional values (Serial Number) in textbox (txt_Rec), if i select "Sale" from combobox(Me.cmb_Type)dropdown list then i want worksheet("Sale") lastrow serial number in textbox (txt_Rec) and if i select "Purchase" from combobox(cmb_Type)dropdown list then i want worksheet("Purchase") lastrow serial number in textbox (txt_Rec).
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sale")
Dim lastrow As Long
lastrow = Application.WorksheetFunction.CountA(sh.Range("A:A"))
Me.txt_Rec.Value = lastrow
``` dropdown for Item type ```
With Me.cmb_Type
.Clear
.AddItem ""
.AddItem "Sale"
.AddItem "Purchase"
End With
End Sub
Please, copy the next event code in the form code module:
Private Sub cmb_Type_Change()
Dim sh As Worksheet
If cmb_Type.Value <> "" Then
Set sh = ThisWorkbook.Sheets(cmb_Type.Value)
Me.txt_Rec.Text = sh.Range("A" & sh.rows.count).End(xlUp).row
Else
Me.txt_Rec.Text = ""
End If
End Sub
And comment the next code lines from the shown Initialize event:
'Dim lastrow As Long
'lastrow = Application.WorksheetFunction.CountA(sh.Range("A:A"))
'Me.txt_Rec.Value = lastrow
If you want the combo to initially show "Sale", you should add
.ListIndex = 1
after .AddItem "Purchase" and before End With...
Related
here I have serial number in textbox (txt_Rec) from worksheet("Sale") lastrow.
Now i want to get conditional values in textbox (txt_Rec), if i select "Sale" from combobox(Me.cmb_Type)dropdown list then i want worksheet("Sale") lastrow serial number in textbox (txt_Rec) and if i select "Purchase" from combobox(cmb_Type)dropdown list then i want worksheet("Purchase") lastrow serial number in textbox (txt_Rec).
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sale")
Dim lastrow As Long
lastrow = Application.WorksheetFunction.CountA(sh.Range("A:A"))
Me.txt_Rec.Value = lastrow
``` dropdown for Item type ```
With Me.cmb_Type
.Clear
.AddItem ""
.AddItem "Sale"
.AddItem "Purchase"
End With
End Sub
I have some records being displayed in a listbox. I have a 'Hide' button in my userform which when clicked hides the row selected and the row remains in the excel sheet. But if I open the userform again then the data loaded has all the hidden rows. I have created a column 'Active' and assigned it true values. I want to change this value to false when the user selects a row and clicks on hide. I want all the data in the excel sheet to remain and only rows with 'Active' value True will be displayed in the listbox. How do I achieve this?
Here is my code -
Sub Employee_Listbox()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("EMPMaster")
Dim last_row As Long
last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))
If last_row = 1 Then last_row = 2
With Me.ListBox2
.ColumnCount = 6
.ColumnWidths = "150,70,100,50,70,0"
.List = sh.Range("A2:F" & last_row).Value '.RowSource = sh.Name & "!A2:F" & last_row
End With
End Sub
Private Sub CommandButton15_Click() '''Hide button
If Me.ListBox2.ListIndex >= 0 Then
Me.ListBox2.RemoveItem Me.ListBox2.ListIndex
End If
End Sub
Try this out. It uses Match to locate the row on the source worksheet and flag that employee as "Inactive".
Option Explicit
Const MASTER_SHEET As String = "EMPMaster"
Const VAL_ACTIVE = "Active"
Const VAL_INACTIVE = "Inactive"
Private Sub UserForm_Activate()
LoadEmployeeList
End Sub
Sub LoadEmployeeList()
Dim sh As Worksheet, rw As Range, i As Long
Set sh = MasterSheet
With Me.ListBox2
.Clear
.ColumnCount = 6
.ColumnWidths = "150,70,100,50,70,0"
End With
For Each rw In sh.Range("A2:F" & sh.Cells(Rows.Count, "A").End(xlUp).Row).Rows
If rw.Columns("G").Value = VAL_ACTIVE Then 'only load "Active" employees
With Me.ListBox2
'add the row
.AddItem (rw.Cells(1).Value)
For i = 2 To rw.Cells.Count
.List(.ListCount - 1, i - 1) = rw.Cells(i).Value
Next i
End With
End If
Next rw
End Sub
Private Sub CommandButton15_Click() '''Hide button
Dim id, m, sh As Worksheet
If Me.ListBox2.ListIndex >= 0 Then
id = Me.ListBox2.List(Me.ListBox2.ListIndex, 0) 'adjust id column to suit
Set sh = MasterSheet
m = Application.Match(id, sh.Columns("A"), 0) 'find the id on the master sheet
If Not IsError(m) Then 'found?
sh.Cells(m, "G").Value = "Inactive" 'mark as inactive
Me.ListBox2.RemoveItem Me.ListBox2.ListIndex 'remove from listbox
Else
'should not happen!
MsgBox "Employee Id '" & id & "' not found on Master sheet!", vbExclamation
End If
End If
End Sub
Function MasterSheet() As Worksheet
Set MasterSheet = ThisWorkbook.Worksheets(MASTER_SHEET)
End Function
I am working on Userforms in VBA for the first time. I have a calendar userform from which I select a date which is displayed on a textbox. By default the textbox shows the current day. At the bottom I have a listbox. I want to filter the data in the listbox based on the current date/date selected by the user.
I am doing this but it does produce any result in the listbox. Do I need to convert the date into some other type?
Sub Attendance_Display_Listbox()
Dim dsh As Worksheet
Set dsh = ThisWorkbook.Sheets("Attendance")
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("AttendanceDisplay")
'''Filter data datewise
dsh.UsedRange.AutoFilter 5, "=" & Me.txt_Date.Value
sh.Cells.ClearContents
dsh.UsedRange.Copy
sh.Range("A1").PasteSpecial xlPasteValues
sh.Range("A1").PasteSpecial xlPasteFormats
dsh.AutoFilterMode = False
Dim last_row As Long
last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))
If last_row = 1 Then last_row = 2
With Me.ListBox1
.ColumnHeads = True
.ColumnCount = 8
.ColumnWidths = "0,50,200,150,70,50,100,70" '0 for not displaying the Serial no
.RowSource = sh.Name & "!A2:H" & last_row
End With
End Sub
For a different date selected then -
Private Sub txt_Date_Change()
Call Attendance_Display_Listbox
End Sub
Dim dsh As Worksheet
Set dsh = ThisWorkbook.Sheets("Attendance")
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("AttendanceDisplay")
dsh.AutoFilterMode = False
dsh.Range("E:E").NumberFormat = "D-MMM-YYYY"
'''filter
dsh.UsedRange.AutoFilter 5, "=" & Me.txt_Date.Value
sh.UsedRange.Clear
dsh.UsedRange.Copy
sh.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
dsh.AutoFilterMode = False
Dim last_row As Long
last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))
If last_row = 1 Then last_row = 2
With Me.ListBox1
.ColumnHeads = True
.ColumnCount = 8
.ColumnWidths = "0,50,200,150,70,50,100,70" '0 for not displaying the Serial no
.RowSource = sh.Name & "!A2:H" & last_row
End With
End Sub
This works!
question : how gone be the code when we want to filter the data between 2 dates
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 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