Atiqul Haque
New Member
- Joined
- Dec 13, 2020
- Messages
- 45
- Office Version
- 2016
- Platform
- Windows
Dear All,
I made a datasheet and save data in a table by userform. I need to make edit some data and write the edit code, it's recall the data to the userform and after making necessary correction when i enter save command it saved in another row's and the previous one still exist. But i want to replace the previous one by the new edited one.
Find below the codes. I would appreciate if some help me to overcome this problem.
IN USERFORM:
==============
Option Explicit
Private Sub cmbHOA_Change()
Me.ComboBox1.RowSource = ""
Select Case Me.cmbHOA
Case "Salary"
Me.ComboBox1.RowSource = "EN"
Case "Bonus"
Me.ComboBox1.RowSource = "EN"
Case "Allowance"
Me.ComboBox1.RowSource = "Allowance"
Case "Honorarium"
Me.ComboBox1.RowSource = "Hono"
Case "Remuneration"
Me.ComboBox1.RowSource = "Remu"
Case Else
Me.ComboBox1 = ""
End Select
End Sub
----
Private Sub cmdEdit_Click()
Dim msgValue As VbMsgBoxResult
msgValue = MsgBox("Do you want to modify the record?", vbYesNo + vbQuestion, "Modify")
If msgValue = vbYes Then
Call Modify
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
----
Private Sub cmdReset_Click()
Dim msgValue As VbMsgBoxResult
msgValue = MsgBox("Do you want to reset the form?", vbYesNo + vbInformation, "Confirmation")
If msgValue = vbNo Then Exit Sub
Call Reset_frmFormEXP
frmFormEXP.txtVRN.SetFocus
End Sub
-----
Private Sub cmdSave_Click()
Dim msgValue As VbMsgBoxResult
msgValue = MsgBox("Please check the Date before save. Do you want to save the data?", vbYesNo + vbInformation, "Confirmation")
If msgValue = vbNo Then Exit Sub
Call add_frmFormEXP
End Sub
----
Private Sub UserForm_Initialize()
Call Reset_frmFormEXP
End Sub
IN SAVE DATA MODULE:
=====================
Option Explicit
Sub add_frmFormEXP()
Dim rng As Range
Set rng = ActiveSheet.ListObjects("Table1").Range
Dim lastrow As Long
Dim eRow As Long
eRow = [Counta(Test!A:A)] + 1
With frmFormEXP
If .txtVRN.Value = "" Then
MsgBox "Please enter voucher no.", vbCritical, "Error"
.txtVRN.SetFocus
.txtVRN.BackColor = vbYellow
Exit Sub
End If
lastrow = rng.Find(What:="*", _
After:=rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
ActiveSheet.Unprotect "639"
rng.Parent.Cells(lastrow + 1, 1).Value = lastrow - 10
rng.Parent.Cells(lastrow + 1, 2).Value = .txtDate.Value
rng.Parent.Cells(lastrow + 1, 3).Value = .txtVRN.Value
rng.Parent.Cells(lastrow + 1, 4).Value = .txtID.Value
rng.Parent.Cells(lastrow + 1, 5).Value = .txtReg.Value
rng.Parent.Cells(lastrow + 1, 6).Value = .cmbTNT.Value
rng.Parent.Cells(lastrow + 1, 7).Value = .cmbHOA.Value
rng.Parent.Cells(lastrow + 1, 8).Value = .ComboBox1.Value
rng.Parent.Cells(lastrow + 1, 9).Value = .txtDes.Value
rng.Parent.Cells(lastrow + 1, 10).Value = .txtNAP.Value
rng.Parent.Cells(lastrow + 1, 11).Value = [Text(Now(), "DD-MM-YYYY HH:MM AM/PM")]
'Reset the userform
.txtVRN.Value = ""
.txtID.Value = ""
.txtReg.Value = ""
.cmbTNT.Value = ""
.cmbHOA.Value = ""
.ComboBox1.Value = ""
.txtDes.Value = ""
.txtNAP.Value = ""
.txtVRN.BackColor = vbWhite
.cmbTNT.BackColor = vbWhite
.cmbHOA.BackColor = vbWhite
.ComboBox1.BackColor = vbWhite
.txtNAP.BackColor = vbWhite
.txtVRN.SetFocus
ActiveSheet.Protect "639"
End With
End Sub
IN RESET_DATA MODULE:
====================
Option Explicit
Sub Reset_frmFormEXP()
Dim eRow As Long
eRow = [Counta(Test!A:A)] + 1
With frmFormEXP
.txtVRN.Value = ""
.txtID.Value = ""
.txtReg.Value = ""
.cmbTNT.Value = ""
.cmbHOA.Value = ""
.ComboBox1.Value = ""
.txtDes.Value = ""
.txtNAP.Value = ""
.txtVRN.BackColor = vbWhite
.cmbTNT.BackColor = vbWhite
.cmbHOA.BackColor = vbWhite
.ComboBox1.BackColor = vbWhite
.txtNAP.BackColor = vbWhite
.txtVRN.SetFocus
.lstEXP.ColumnCount = 10
.lstEXP.ColumnHeads = True
.lstEXP.ColumnWidths = "15,40,40,40,40,55,55,55,55,30"
If eRow > 1 Then
.lstEXP.RowSource = "Dashboard!A12:J12" & eRow
Else
.lstEXP.RowSource = "Dashboard!A12:J12"
End If
End With
End Sub
IN EDIT_DATA MODULE:
====================
Sub Modify()
Dim eRow As Long
Dim eSerial As Long
eSerial = Application.InputBox("Please enter Serial Number to make modification.", "Modify", , , , , , 1)
On Error Resume Next
eRow = Application.WorksheetFunction.IfError(Application.WorksheetFunction.Match(eSerial, Sheets("Dashboard").Range("A:A"), 0), 0)
On Error GoTo 0
If eRow = 0 Then
MsgBox "No record found.", vbOKOnly + vbCritical, "No Record"
Exit Sub
End If
ActiveSheet.Unprotect "639"
With frmFormEXP
.txtDate.Value = Sheets("Dashboard").Cells(eRow, 2).Value
.txtVRN.Value = Sheets("Dashboard").Cells(eRow, 3).Value
.txtID.Value = Sheets("Dashboard").Cells(eRow, 4).Value
.txtReg.Value = Sheets("Dashboard").Cells(eRow, 5).Value
.cmbTNT.Value = Sheets("Dashboard").Cells(eRow, 6).Value
.cmbHOA.Value = Sheets("Dashboard").Cells(eRow, 7).Value
.ComboBox1.Value = Sheets("Dashboard").Cells(eRow, 8).Value
.txtDes.Value = Sheets("Dashboard").Cells(eRow, 9).Value
.txtNAP.Value = Sheets("Dashboard").Cells(eRow, 10).Value
ActiveSheet.Protect "639"
End With
End Sub
I made a datasheet and save data in a table by userform. I need to make edit some data and write the edit code, it's recall the data to the userform and after making necessary correction when i enter save command it saved in another row's and the previous one still exist. But i want to replace the previous one by the new edited one.
Find below the codes. I would appreciate if some help me to overcome this problem.
IN USERFORM:
==============
Option Explicit
Private Sub cmbHOA_Change()
Me.ComboBox1.RowSource = ""
Select Case Me.cmbHOA
Case "Salary"
Me.ComboBox1.RowSource = "EN"
Case "Bonus"
Me.ComboBox1.RowSource = "EN"
Case "Allowance"
Me.ComboBox1.RowSource = "Allowance"
Case "Honorarium"
Me.ComboBox1.RowSource = "Hono"
Case "Remuneration"
Me.ComboBox1.RowSource = "Remu"
Case Else
Me.ComboBox1 = ""
End Select
End Sub
----
Private Sub cmdEdit_Click()
Dim msgValue As VbMsgBoxResult
msgValue = MsgBox("Do you want to modify the record?", vbYesNo + vbQuestion, "Modify")
If msgValue = vbYes Then
Call Modify
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
----
Private Sub cmdReset_Click()
Dim msgValue As VbMsgBoxResult
msgValue = MsgBox("Do you want to reset the form?", vbYesNo + vbInformation, "Confirmation")
If msgValue = vbNo Then Exit Sub
Call Reset_frmFormEXP
frmFormEXP.txtVRN.SetFocus
End Sub
-----
Private Sub cmdSave_Click()
Dim msgValue As VbMsgBoxResult
msgValue = MsgBox("Please check the Date before save. Do you want to save the data?", vbYesNo + vbInformation, "Confirmation")
If msgValue = vbNo Then Exit Sub
Call add_frmFormEXP
End Sub
----
Private Sub UserForm_Initialize()
Call Reset_frmFormEXP
End Sub
IN SAVE DATA MODULE:
=====================
Option Explicit
Sub add_frmFormEXP()
Dim rng As Range
Set rng = ActiveSheet.ListObjects("Table1").Range
Dim lastrow As Long
Dim eRow As Long
eRow = [Counta(Test!A:A)] + 1
With frmFormEXP
If .txtVRN.Value = "" Then
MsgBox "Please enter voucher no.", vbCritical, "Error"
.txtVRN.SetFocus
.txtVRN.BackColor = vbYellow
Exit Sub
End If
lastrow = rng.Find(What:="*", _
After:=rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
ActiveSheet.Unprotect "639"
rng.Parent.Cells(lastrow + 1, 1).Value = lastrow - 10
rng.Parent.Cells(lastrow + 1, 2).Value = .txtDate.Value
rng.Parent.Cells(lastrow + 1, 3).Value = .txtVRN.Value
rng.Parent.Cells(lastrow + 1, 4).Value = .txtID.Value
rng.Parent.Cells(lastrow + 1, 5).Value = .txtReg.Value
rng.Parent.Cells(lastrow + 1, 6).Value = .cmbTNT.Value
rng.Parent.Cells(lastrow + 1, 7).Value = .cmbHOA.Value
rng.Parent.Cells(lastrow + 1, 8).Value = .ComboBox1.Value
rng.Parent.Cells(lastrow + 1, 9).Value = .txtDes.Value
rng.Parent.Cells(lastrow + 1, 10).Value = .txtNAP.Value
rng.Parent.Cells(lastrow + 1, 11).Value = [Text(Now(), "DD-MM-YYYY HH:MM AM/PM")]
'Reset the userform
.txtVRN.Value = ""
.txtID.Value = ""
.txtReg.Value = ""
.cmbTNT.Value = ""
.cmbHOA.Value = ""
.ComboBox1.Value = ""
.txtDes.Value = ""
.txtNAP.Value = ""
.txtVRN.BackColor = vbWhite
.cmbTNT.BackColor = vbWhite
.cmbHOA.BackColor = vbWhite
.ComboBox1.BackColor = vbWhite
.txtNAP.BackColor = vbWhite
.txtVRN.SetFocus
ActiveSheet.Protect "639"
End With
End Sub
IN RESET_DATA MODULE:
====================
Option Explicit
Sub Reset_frmFormEXP()
Dim eRow As Long
eRow = [Counta(Test!A:A)] + 1
With frmFormEXP
.txtVRN.Value = ""
.txtID.Value = ""
.txtReg.Value = ""
.cmbTNT.Value = ""
.cmbHOA.Value = ""
.ComboBox1.Value = ""
.txtDes.Value = ""
.txtNAP.Value = ""
.txtVRN.BackColor = vbWhite
.cmbTNT.BackColor = vbWhite
.cmbHOA.BackColor = vbWhite
.ComboBox1.BackColor = vbWhite
.txtNAP.BackColor = vbWhite
.txtVRN.SetFocus
.lstEXP.ColumnCount = 10
.lstEXP.ColumnHeads = True
.lstEXP.ColumnWidths = "15,40,40,40,40,55,55,55,55,30"
If eRow > 1 Then
.lstEXP.RowSource = "Dashboard!A12:J12" & eRow
Else
.lstEXP.RowSource = "Dashboard!A12:J12"
End If
End With
End Sub
IN EDIT_DATA MODULE:
====================
Sub Modify()
Dim eRow As Long
Dim eSerial As Long
eSerial = Application.InputBox("Please enter Serial Number to make modification.", "Modify", , , , , , 1)
On Error Resume Next
eRow = Application.WorksheetFunction.IfError(Application.WorksheetFunction.Match(eSerial, Sheets("Dashboard").Range("A:A"), 0), 0)
On Error GoTo 0
If eRow = 0 Then
MsgBox "No record found.", vbOKOnly + vbCritical, "No Record"
Exit Sub
End If
ActiveSheet.Unprotect "639"
With frmFormEXP
.txtDate.Value = Sheets("Dashboard").Cells(eRow, 2).Value
.txtVRN.Value = Sheets("Dashboard").Cells(eRow, 3).Value
.txtID.Value = Sheets("Dashboard").Cells(eRow, 4).Value
.txtReg.Value = Sheets("Dashboard").Cells(eRow, 5).Value
.cmbTNT.Value = Sheets("Dashboard").Cells(eRow, 6).Value
.cmbHOA.Value = Sheets("Dashboard").Cells(eRow, 7).Value
.ComboBox1.Value = Sheets("Dashboard").Cells(eRow, 8).Value
.txtDes.Value = Sheets("Dashboard").Cells(eRow, 9).Value
.txtNAP.Value = Sheets("Dashboard").Cells(eRow, 10).Value
ActiveSheet.Protect "639"
End With
End Sub