Userform to update database and to show data

Lars1

Board Regular
Joined
Feb 3, 2021
Messages
98
Office Version
  1. 365
Platform
  1. Windows
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;
1612342755341.png


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 :)
 

Some videos you may like

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

fadee2

Active Member
Joined
Nov 7, 2020
Messages
335
Office Version
  1. 2019
Platform
  1. Windows
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

Board Regular
Joined
Feb 3, 2021
Messages
98
Office Version
  1. 365
Platform
  1. Windows
Sorry. Here is a sample file...
This is how far i reached in this small project.

 

fadee2

Active Member
Joined
Nov 7, 2020
Messages
335
Office Version
  1. 2019
Platform
  1. Windows
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:

VBA Code:
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....
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,127,395
Messages
5,624,479
Members
416,029
Latest member
CSM1

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top