Fully Automatic Data Entry Form - 2 | Edit and Delete Entry

 


Fully Automatic Data Entry Form - 2 | Edit and Delete Entry

Download VBA Code:- Click here

Download Practic File:- Click here

VBA Code

Option Explicit

Sub Reset()

Dim i As Long

i = [Counta(Database!A:A)]

With frmform

.txtname.Value = ""

.txtID.Value = ""

.txtcont.Value = ""

.txtdate.Value = ""

.txtcity.Value = ""

.optmale.Value = False

.Optfemale.Value = False

.cmddesg.Clear

.cmddesg.AddItem "Manager"

.cmddesg.AddItem "Accountant"

.cmddesg.AddItem "Supervisor"

.cmddesg.AddItem "Peon"

.cmddesg.AddItem "Cleark"

.txtRowNumber.Value = ""

.Lstdatabase.ColumnCount = 8

.Lstdatabase.ColumnHeads = True

.Lstdatabase.ColumnWidths = "30,68,80,75,75,55,50,55"

If i > 1 Then

.Lstdatabase.RowSource = "Database!A2:H" & i

Else

.Lstdatabase.RowSource = "Database!A2:H2"

End If

End With

End Sub

Sub submit()

Dim sh As Worksheet

Dim i As Long

Set sh = ThisWorkbook.Sheets("Database")

If frmform.txtRowNumber.Value = "" Then

i = [Counta(Database!A:A)] + 1

Else

    i = frmform.txtRowNumber.Value

    End If

    With sh

.Cells(i, 1) = i - 1

.Cells(i, 2) = frmform.txtname.Value

.Cells(i, 3) = frmform.txtID.Value

.Cells(i, 4) = frmform.txtcont.Value

.Cells(i, 5) = frmform.txtdate.Value

.Cells(i, 6) = frmform.txtcity.Value

.Cells(i, 7) = IIf(frmform.Optfemale.Value = True, "Female", "Male")

.Cells(i, 8) = frmform.cmddesg.Value

End With

End Sub

Sub show_form()

frmform.Show

End Sub

Function selected_List() As Long

Dim E As Long

selected_List = 0

For E = 0 To frmform.Lstdatabase.ListCount - 1

If frmform.Lstdatabase.Selected(E) = True Then

selected_List = E + 1

Exit For

End If

Next E

End Function

*******************************************************

Private Sub cmdcancel_Click()

Dim msgValue As VbMsgBoxResult

msgValue = MsgBox("Do you want to reset it?", vbYesNo + vbInformation, "Confirmation")

If msgValue = vbNo Then Exit Sub

Call Reset

End Sub

Private Sub cmdDelete_Click()

If selected_List = 0 Then

            MsgBox "No row is selected.", vbOKOnly + vbInformation, "Delete"

        Exit Sub

    End If

    Dim i As VbMsgBoxResult

    i = MsgBox("Do you want to delete the selected record?", vbYesNo + vbQuestion, "Confirmation")

    If i = vbNo Then Exit Sub

    ThisWorkbook.Sheets("Database").Rows(selected_List + 1).Delete

    Call Reset

    MsgBox "Selected record has been deleted.", vbOKOnly + vbInformation, "Deleted"

End Sub

Private Sub cmddesg_Change()

Me.txtID.Value = "Reg-" & Left(Me.cmddesg, 2) & Me.txtdate.Value

End Sub

***************************************************

Private Sub cmdEdit_Click()

If selected_List = 0 Then

MsgBox "No Row is selected.", vbOKOnly + vbInformation, "Edit"

Exit Sub

End If

'this code to update the value to respective contors

Dim gender As String

Me.txtRowNumber.Value = selected_List + 1

Me.txtname.Value = Me.Lstdatabase.List(Me.Lstdatabase.ListIndex, 1)

Me.txtID.Value = Me.Lstdatabase.List(Me.Lstdatabase.ListIndex, 2)

Me.txtcont.Value = Me.Lstdatabase.List(Me.Lstdatabase.ListIndex, 3)

Me.txtdate.Value = Me.Lstdatabase.List(Me.Lstdatabase.ListIndex, 4)

Me.txtcity.Value = Me.Lstdatabase.List(Me.Lstdatabase.ListIndex, 5)

gender = Me.Lstdatabase.List(Me.Lstdatabase.ListIndex, 6)

If gender = "Female" Then

    Me.Optfemale.Value = True

Else

Me.optmale.Value = True

End If

Me.cmddesg.Value = Me.Lstdatabase.List(Me.Lstdatabase.ListIndex, 7)

MsgBox "Please make th erequired changes and click on 'save' button to update.", vbOKOnly + vbInformation, "Edit"

End Sub

Private Sub cmdsave_Click()

Dim msgValue As VbMsgBoxResult

msgValue = MsgBox("Do you want to save it?", vbYesNo + vbInformationn, "Confirmation")

If msgValue = vbNo Then Exit Sub

Call submit

Call Reset

End Sub

***************************************

Private Sub txtdate_Change()

Me.txtID.Value = "Reg-" & Left(Me.cmddesg, 2) & Me.txtdate.Value

End Sub

Private Sub UserForm_Initialize()

Call Reset

End Sub

Download VBA Code:- Click here

Download Practic File:- Click here

कोई टिप्पणी नहीं

टिप्पणी: केवल इस ब्लॉग का सदस्य टिप्पणी भेज सकता है.

Send Multiple Emails From Excel | Send Bulk Mail from Excel Sheet with Attachment in One Click

Send Multiple Emails From Excel | Send Bulk Mail from Excel Sheet with Attachment in One Click Download VBA Code Notepad file - Click here D...

Blogger द्वारा संचालित.