How to bind data from one sheet row till end of the row into combobox using macro - excel

please provide me a solution for this issue.
I am new to macro I am unable to do this operation.
I tried this code
Sub BindCombo()
Dim Last
Last = Sheets("Defect Dump").Cells(2, 2).End(xlDown).Row
With ComboBox1
For Row = 2 To Last
.AddItem Sheets("Defect Dump").Cells(Row, 1)
Next Row
End With
End Sub
But this code shows object error

You need to create an object reference to the ComboBox
try this
Sub BindCombo()
Dim Last As Long, rw As Long
Dim sh As Worksheet
Dim cb As ComboBox
Set sh = Sheets("Defect Dump")
Last = sh.Cells(2, 2).End(xlDown).Row
' get Combobox on "project sheet" sheet
Set cb = Sheets("project sheet").Shapes("ComboBox1").DrawingObject.Object
With cb
.Clear ' remove any existing items
For rw = 2 To Last
.AddItem sh.Cells(rw, 1)
Next
End With
End Sub

Related

How can I hide row in list box based on a column value in VBA userform?

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

How to use information from a ComboBox in another one?

I'm trying to make a UserForm with comboboxes and textboxes. I have two combobox that are working together. In the first one you choose the right sheet and in the second you choose the right column in the selected sheet.
My problem is that even though my code is working, the second combobox doesn't use the moving information from the first one. It always displays the columns from the first sheet whatever my choice. So how do I get the data from the first one to use it in the second one?
Here's my code:
Private Sub UserForm_Initialize()
Dim I As Long
Me.ComboBox1.Clear
For I = 7 To Sheets.Count
Me.ComboBox1.AddItem Sheets(I).Name
Next
Me.ComboBox1.Value = ActiveSheet.Name
Me.ComboBox2.Clear
Dim j As Integer
Dim puits As String
j = 3
Do While Worksheets(ComboBox1.Text).Cells(1, j).Value <> ""
Me.ComboBox2.AddItem Worksheets(Me.ComboBox1.Text).Cells(1, j).Value
j = j + 3
Loop
End Sub```
EDIT
[USF is to automate the change of the selected cell in this screenshort, same tables on different sheets][1]
[1]: https://i.stack.imgur.com/7bbQG.png
You need to use the Combobox_Change-Event. This Example shows what I mean:
Private Sub ComboBox1_Change()
Dim ws As Worksheet
Dim lCol As Long, i As Long
Set ws = ThisWorkbook.Worksheets(UserForm1.ComboBox1.Value)
lCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
For i = 1 To lCol
UserForm1.ComboBox2.AddItem ws.Cells(1, i).Value
Next
End Sub
Private Sub UserForm_Initialize()
Me.ComboBox1.Clear
Me.ComboBox2.Clear
Dim ws As Worksheet
Dim i As Long
i = 1
For Each ws In ThisWorkbook.Worksheets
Me.ComboBox1.AddItem ws.Name
i = i + 1
Next ws
End Sub
When I select the Sheet, I change the first Combobox, which triggers the Change-Event. And I then populate the second Combobox according to the selected sheet.
EDIT
You could insert a CommandButton and use code like the following:
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim rng As Range
Set ws = ThisWorkbook.Worksheets(UserForm1.ComboBox1.Value)
Set rng = ws.Range(UserForm1.ComboBox2.Value)
rng.Value = "Your Date"
End Sub

Filter a Listbox based on 2 Combobox(es)

So i'm very new to coding and want to learn how can i filter a listbox based on selection on 2 comboboxes. So what i want to do is when VBA initializes the entire range displays on the listbox and when 1 combobox is selected it filters down the range and when the second combobox is selected it filters down even more and both comboboxes can be used individually. but i couldnt find anything online either for VBA excel or something similar.
Private Sub ComboBox1_Change()
Dim Database(1 To 100, 1 To 4)
Dim my_range As Integer
Dim colum As Byte
On Error Resume Next
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("MASTER")
sh.Range("G5").AutoFilter Field:=7, Criteria1:=Me.ComboBox1.Value
For i = 5 To sh.Range("G100000").End(xlUp).Row
If sh.Cells(i, 1) = Me.ComboBox1 Then
my_range = my_range + 1
For colum = 1 To 5
Database(my_range, colum) = sh.Cells(i, colum)
Next colum
End If
Next i
Me.ListBox1.List = Database
End Sub
Private Sub UserForm_Initialize()
With Me.ComboBox1
.Clear
.AddItem ""
.AddItem "L461"
.AddItem "L462"
.AddItem "L463"
.AddItem "L464"
.AddItem "L465"
End With
End Sub

How to continue the sequence of the unique numbers in the excel sheet after closing the userform?

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

Remove duplicate form combobox

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

Resources