KlausW
Active Member
- Joined
- Sep 9, 2020
- Messages
- 453
- Office Version
- 2016
- Platform
- Windows
Hi, I use this VBA code I found on the web to create new items with. I can't figure out how to change the order of entering information in the Userform. So they are in the correct columns. Anyone who can help?
I have tried to illustrate it with a few pictures.
Any help will be appreciated.
Best regards
Klaus W
Excel file
I have tried to illustrate it with a few pictures.
Any help will be appreciated.
Best regards
Klaus W
Excel file
VBA Code:
''''''''''''''''''UserForm Activation'''''''''''''''''''''''''
Private Sub Image1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
End Sub
Private Sub UserForm_Activate()
cmbGender.List = Range("l2:l83").Value
cmbDepartment.List = Range("p2:p10").Value
Call Refresh_data
End Sub
''''''''''''''''''''''Save Button'''''''''''''''''''''''''''''''
Private Sub cmdSave_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Worksheet")
Dim lr As Long
lr = Sheets("Worksheet").Range("A" & Rows.Count).End(xlUp).Row
'''''''''''''''Validation'''''''''
If Me.txtName.Value = "" Then
MsgBox "Please enter the Employee name", vbCritical
Exit Sub
End If
If IsNumeric(Me.txtID.Value) = False Then
MsgBox "Please enter the correct employee ID"
Exit Sub
End If
'''''''''''''''''Add Data in Excel Sheet'''''''''''''
With sh
.Cells(lr + 1, "A").Value = Me.txtID.Value
.Cells(lr + 1, "B").Value = Me.txtName.Value
.Cells(lr + 1, "C").Value = Me.txtAddress.Value
.Cells(lr + 1, "D").Value = Me.cmbGender.Value
.Cells(lr + 1, "e").Value = Me.txtSalary.Value
.Cells(lr + 1, "F").Value = Me.txtEmail.Value
.Cells(lr + 1, "g").Value = Me.txtContact.Value
.Cells(lr + 1, "h").Value = Me.cmbDepartment.Value
End With
''''''''''''''''Clear Boxes''''''''''''''''
Me.txtID.Value = ""
Me.txtName.Value = ""
Me.txtAddress.Value = ""
Me.cmbGender.Value = ""
Me.txtContact.Value = ""
Me.txtEmail.Value = ""
Me.txtSalary.Value = ""
Me.cmbDepartment.Value = ""
Call Refresh_data
MsgBox "Product has been added in the Worksheet", vbInformation
txtID.SetFocus
Macro3
End Sub
'''''''''''''''''''Display Data in the Listbox''''''''''''''
Sub Refresh_data()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Worksheet")
Dim lr As Long
lr = Sheets("Worksheet").Range("A" & Rows.Count).End(xlUp).Row
If lr = 6 Then lr = 7
With Me.ListBox
.ColumnCount = 8
.ColumnHeads = True
.ColumnWidths = "80,140,70,130,100,150,80,80"
.RowSource = "Worksheet!A2:H" & lr
End With
End Sub
'''''''''''''''''Reset Button'''''''''''''''''''
Private Sub cmdReset_Click()
Unload Me
UserForm.Show
End Sub
''''''''''''''''''''Exit Button'''''''''''''''''''''
Private Sub cmdExit_Click()
If MsgBox("Do you want to exit this form?", vbQuestion + vbYesNo, "Confirmation") = vbYes Then
Unload Me
End If
End Sub
'''''''''''''''''''''''''SearchButton''''''''''''''''''''''
Private Sub cmdSearch_Click()
Dim X As Long
Dim Y As Long
X = Sheets("Worksheet").Range("A" & Rows.Count).End(xlUp).Row
For Y = 7 To X
If Sheets("Worksheet").Cells(Y, 1).Value = txtSearch.Text Then
txtID = Sheets("Worksheet").Cells(Y, 1).Value
txtName = Sheets("Worksheet").Cells(Y, 2).Value
txtAddress = Sheets("Worksheet").Cells(Y, 3).Value
cmbGender = Sheets("Worksheet").Cells(Y, 4).Value
txtContact = Sheets("Worksheet").Cells(Y, 5).Value
txtEmail = Sheets("Worksheet").Cells(Y, 6).Value
txtSalary = Sheets("Worksheet").Cells(Y, 7).Value
cmbDepartment = Sheets("Worksheet").Cells(Y, 8).Value
End If
Next Y
End Sub
''''''''''''''''''''Update Button'''''''''''''''
Private Sub cmdUpdate_Click()
Dim X As Long
Dim Y As Long
X = Sheets("Worksheet").Range("A" & Rows.Count).End(xlUp).Row
'''''''''''''''Validation'''''''''
If Me.txtName.Value = "" Then
MsgBox "Please enter the Employee name", vbCritical
Exit Sub
End If
If IsNumeric(Me.txtID.Value) = False Then
MsgBox "Please enter the correct employee ID"
Exit Sub
End If
'''''''''''''''''Add update in Excel Sheet'''''''''''''
For Y = 7 To X
If Sheets("Worksheet").Cells(Y, 1).Value = txtSearch.Text Then
Sheets("Worksheet").Cells(Y, 1).Value = txtID
Sheets("Worksheet").Cells(Y, 2).Value = txtName
Sheets("Worksheet").Cells(Y, 3).Value = txtAddress
Sheets("Worksheet").Cells(Y, 4).Value = cmbGender
Sheets("Worksheet").Cells(Y, 5).Value = txtContact
Sheets("Worksheet").Cells(Y, 6).Value = txtEmail
Sheets("Worksheet").Cells(Y, 7).Value = cmbDepartment
Sheets("Worksheet").Cells(Y, 8).Value = txtSalary
End If
Next Y
''''''''''''''''Clear Boxes''''''''''''''''
Me.txtSearch.Value = ""
Me.txtID.Value = ""
Me.txtName.Value = ""
Me.txtAddress.Value = ""
Me.cmbGender.Value = ""
Me.txtContact.Value = ""
Me.txtEmail.Value = ""
Me.txtSalary.Value = ""
Me.cmbDepartment.Value = ""
MsgBox "Product has been updated in the Worksheet", vbInformation
End Sub
''''''''''''''''Delete Button'''''''''''''''
Private Sub cmdDelete_Click()
Dim X As Long
Dim Y As Long
X = Sheets("Worksheet").Range("A" & Rows.Count).End(xlUp).Row
For Y = 7 To X
If Sheets("Worksheet").Cells(Y, 1).Value = txtSearch.Text Then
Rows(Y).Delete
End If
Next Y
''''''''''''''''Clear Boxes''''''''''''''''
Me.txtSearch.Value = ""
Me.txtID.Value = ""
Me.txtName.Value = ""
Me.txtAddress.Value = ""
Me.cmbGender.Value = ""
Me.txtContact.Value = ""
Me.txtEmail.Value = ""
Me.txtSalary.Value = ""
Me.cmbDepartment.Value = ""
MsgBox "Product has been deleted from the Worksheet", vbInformation
End Sub
'''''''''''''''''' DbClick on List Box Code'''''''''''''''
Private Sub ListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
txtSearch.Text = ListBox.Column(0)
If txtSearch.Text = Me.ListBox.Column(0) Then
txtID.Text = Me.ListBox.Column(0)
txtName.Text = Me.ListBox.Column(1)
txtAddress.Text = Me.ListBox.Column(2)
cmbGender.Text = Me.ListBox.Column(3)
txtContact.Text = Me.ListBox.Column(4)
txtEmail.Text = Me.ListBox.Column(5)
txtSalary.Text = Me.ListBox.Column(6)
cmbDepartment.Text = Me.ListBox.Column(7)
End If
End Sub
