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

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

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

How To Convert Data in Columns into Rows in Excel Document

How To Convert Data in Columns into Rows in Excel Document Download Notepad file - Clickhere Copy code here: Function SplitCellToRows(CellVa...

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