Userform to update database and to show data

[Lars1]

As a novice ind VBA i am sorry if this issue already has been answered.

I have an excel sheet with data containing information about personel and products
I would like to create en Userform to update a sheet called "Database" with the following information;

When you click "Send data/Update" the "database" is updated with the information from the Userform.

In the sheet "database" there is some calculations which means the sheet "Database" containing these columns:
Date
Employee number
Employee Name
Product number
Product Name
Number of products manufactured
Manufacturing Code
Price
Total price

All these information should appear in the Listbox after update of the "Employee number" Combobox.

After clicking "Send data/Update" the new data should appear in the Listbox.

The Listbox should be sorted with the newest date on top.

Could anybody in here help with this ?
Thanks

 

[fadee2]

Hi Lars1

Welcome to the board.

I would suggest uploading a sample file with some sample data along with the query. This would make it easier for everyone trying to help in suggesting a solution, rather than using assumptions and creating their own data.

You can use xl2bb addin or upload the sample file to any free service like dropbox or onedrive.

 

[Lars1]

Sorry. Here is a sample file...
This is how far i reached in this small project.

Transfer - Dropbox

Dropbox is a free service that lets you bring your photos, docs, and videos anywhere and share them easily. Never email yourself a file again!

www.dropbox.com

 

[fadee2]

Hi Lars1,

Sorry for late reply.

for

All these information should appear in the Listbox after update of the "Employee number" Combobox.

the idea would be to copy data based on Combobox value and place it on another sheet (tmp) and then point your listbox to tmp. This would reflect only the data based on combobox value.

for

After clicking "Send data/Update" the new data should appear in the Listbox.

listbox rowsource should be changed to sheet(database) to reflect all data.

try the following with your worksheet.
1. Add another worksheet and rename it as tmp.
2. update your sub under frmParts with the one below:

Option Explicit


'Additioanl Piece of Code to display list relevant to EmpID ComboBox
'=========================================
Private Sub cboPart_AfterUpdate()
Dim cri As String
Dim lr As Long
Dim visiblecellscount As Long
Dim rng As Range
Dim src As Range

'Select ComboBox value as string
cri = cboPart.Value

'Lastrow of data in Database
lr = Sheets("database").Cells(Rows.Count, 1).End(xlUp).Row

'Dilter Database based on ComboBox Value
Sheets("database").Range("a1:j1").AutoFilter Field:=1, Criteria1:=cri

'Count visiblecells in database after filter
visiblecellscount = Sheets("database").ListObjects("Tabel2").Range.Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count


If visiblecellscount < 2 Then
    MsgBox "New Record"
    ListBox1.RowSource = "Tabel2"
Else

'Define range with data in database after filter
Set rng = Sheets("database").Range("a1", "j" & lr)

'Copy defined range
rng.SpecialCells(xlCellTypeVisible).Copy

'Goto tmp --- Sheet added specifically for query resolution
Sheets("tmp").Activate

'Delete previous data
 On Error Resume Next
    Sheets("tmp").ListObjects("temp_table").Delete

'Paste data copied from database
Sheets("tmp").Range("a1").PasteSpecial Paste:=xlPasteValues

'Define range on tmp sheet
Set src = Sheets("tmp").Range("A1").CurrentRegion

'create table on tmp sheet
Sheets("tmp").ListObjects.Add(SourceType:=xlSrcRange, Source:=src, _
xlListObjectHasHeaders:=xlYes, tablestyleName:="TableStyleMedium28").Name = "temp_table"

'Refresh listbox with data on temp sheet
ListBox1.RowSource = ""
ListBox1.RowSource = "temp_table"

End If

'remove filter from database
Sheets("database").Range("a1:j1").AutoFilter

'=========================================

End Sub



Private Sub cmdAdd_Click()
Dim lRow As Long
Dim lPart As Long
Dim ws As Worksheet
Set ws = Worksheets("Database")

lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
    
lPart = Me.cboPart.ListIndex

'check for a part number
If Trim(Me.cboPart.Value) = "" Then
  Me.cboPart.SetFocus
  MsgBox "Venligst vælg medarbejder fra listen"
  Exit Sub
End If

'copy the data to the database
With ws
  .Cells(lRow, 1).Value = Me.cboPart.Value
  .Cells(lRow, 2).Value = Me.cboPart.List(lPart, 1)
  .Cells(lRow, 3).Value = Me.cboLocation.Value
  .Cells(lRow, 4).Value = Me.txtDate.Value
  .Cells(lRow, 5).Value = Me.txtQty.Value
  .Cells(lRow, 6).Value = Me.txtAccord.Value
  .Cells(lRow, 8).Value = Me.txtProduct.Value
End With

'clear the data
Me.cboPart.Value = ""
Me.cboLocation.Value = ""
Me.txtDate.Value = Format(Date, "Long Date")
Me.txtQty.Value = 1
Me.txtAccord.Value = ""
Me.txtProduct.Value = ""
Me.cboPart.SetFocus


'=========================================
'Refresh Listbox upon Save

Me.ListBox1.RowSource = ""
Me.ListBox1.RowSource = "Tabel2"
'=========================================


End Sub


Private Sub UserForm_Initialize()
Dim cPart As Range
Dim cLoc As Range
Dim ws As Worksheet
Set ws = Worksheets("Medarbejdere")

For Each cPart In ws.Range("PartIDList")
  With Me.cboPart
    .AddItem cPart.Value
    .List(.ListCount - 1, 1) = cPart.Offset(0, 1).Value
  End With
Next cPart

For Each cLoc In ws.Range("LocationList")
  With Me.cboLocation
    .AddItem cLoc.Value
  End With
Next cLoc

Me.txtDate.Value = Format(Date, "Long Date")
Me.txtQty.Value = 1
Me.cboPart.SetFocus

'=========================================
'Removes Autofilter from Database
Sheets("DATABASE").Range("A1:J1").AutoFilter
'=========================================

End Sub

I have updated your existing code. New information has been commented for your convenience.

hth....