Edit data from a data sheet by userform.

Atiqul Haque

New Member
Joined
Dec 13, 2020
Messages
45
Office Version
  1. 2016
Platform
  1. 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
Pic1.JPGPic3.JPG
 

Attachments

  • Pic2.JPG
    Pic2.JPG
    85.3 KB · Views: 32

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
When you store the serialnumber you can find the row with:
eRow = Application.WorksheetFunction.IfError(Application.WorksheetFunction.Match(eSerial, Sheets("Dashboard").Range("A:A"), 0), 0)

Then you can save the data with lines as:
Sheets("Dashboard").Cells(eRow, 2).Value = .txtDate.Value
 
Upvote 0
When you store the serialnumber you can find the row with:
eRow = Application.WorksheetFunction.IfError(Application.WorksheetFunction.Match(eSerial, Sheets("Dashboard").Range("A:A"), 0), 0)

Then you can save the data with lines as:
Sheets("Dashboard").Cells(eRow, 2).Value = .txtDate.Value
Dear Sir,
Thank you very much for your advice. But i don't understand where shall i put this code you mentioned. I'm novice in codding, so it'll be great if you can help me out of this problem.
Thanks in advance.
 
Upvote 0
VBA Code:
Sub add_frmFormEXP()
    Dim rng As Range
    Set rng = ActiveSheet.Range("Tabel1[Voucher No]")
    Dim rngFound As Range
    Dim lrow As Long

    With frmFormEXP
'check voucher no
        If .txtVRN.Value = "" Then
            MsgBox "Please enter voucher no.", vbCritical, "Error"
            .txtVRN.SetFocus
            .txtVRN.BackColor = vbYellow
            Exit Sub
        End If
'search voucher no
        Set rngFound = rng.Find(What:=.txtVRN, _
        After:=rng.Cells(1), _
        Lookat:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False)
        If Not rngFound Is Nothing Then
            lrow = rngFound.Row
        Else
'search last row
            Set rngFound = rng.Find(What:="*", _
            After:=rng.Cells(1), _
            Lookat:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False)
            lrow = rngFound.Row + 1
        End If
'copy to sheet
        ActiveSheet.Unprotect "639"
        rng.Parent.Cells(lrow, 1).Value = lrow - 9
        rng.Parent.Cells(lrow, 2).Value = .txtDate.Value
        rng.Parent.Cells(lrow, 3).Value = .txtVRN.Value
        rng.Parent.Cells(lrow, 4).Value = .txtID.Value
        rng.Parent.Cells(lrow, 5).Value = .txtReg.Value
        rng.Parent.Cells(lrow, 6).Value = .cmbTNT.Value
        rng.Parent.Cells(lrow, 7).Value = .cmbHOA.Value
        rng.Parent.Cells(lrow, 8).Value = .ComboBox1.Value
        rng.Parent.Cells(lrow, 9).Value = .txtDes.Value
        rng.Parent.Cells(lrow, 10).Value = .txtNAP.Value
        rng.Parent.Cells(lrow, 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
 
Upvote 0
VBA Code:
Sub add_frmFormEXP()
    Dim rng As Range
    Set rng = ActiveSheet.Range("Tabel1[Voucher No]")
    Dim rngFound As Range
    Dim lrow As Long

    With frmFormEXP
'check voucher no
        If .txtVRN.Value = "" Then
            MsgBox "Please enter voucher no.", vbCritical, "Error"
            .txtVRN.SetFocus
            .txtVRN.BackColor = vbYellow
            Exit Sub
        End If
'search voucher no
        Set rngFound = rng.Find(What:=.txtVRN, _
        After:=rng.Cells(1), _
        Lookat:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False)
        If Not rngFound Is Nothing Then
            lrow = rngFound.Row
        Else
'search last row
            Set rngFound = rng.Find(What:="*", _
            After:=rng.Cells(1), _
            Lookat:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False)
            lrow = rngFound.Row + 1
        End If
'copy to sheet
        ActiveSheet.Unprotect "639"
        rng.Parent.Cells(lrow, 1).Value = lrow - 9
        rng.Parent.Cells(lrow, 2).Value = .txtDate.Value
        rng.Parent.Cells(lrow, 3).Value = .txtVRN.Value
        rng.Parent.Cells(lrow, 4).Value = .txtID.Value
        rng.Parent.Cells(lrow, 5).Value = .txtReg.Value
        rng.Parent.Cells(lrow, 6).Value = .cmbTNT.Value
        rng.Parent.Cells(lrow, 7).Value = .cmbHOA.Value
        rng.Parent.Cells(lrow, 8).Value = .ComboBox1.Value
        rng.Parent.Cells(lrow, 9).Value = .txtDes.Value
        rng.Parent.Cells(lrow, 10).Value = .txtNAP.Value
        rng.Parent.Cells(lrow, 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
Thank you very much for your support.
But it shows run time error. Sending you the pic for your reference.
Best Rgds,Run-time error.JPG
 
Upvote 0
replace the lines search last row with:
VBA Code:
'search last row
            lrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row + 1
 
Upvote 0
Dear Sir,

Unfortunately it's not working properly. I'm sending you the whole workbook for your reference.


Best Rgds,
Thank you very much Sir,
It's working but facing the following problems:
1) When i put duplicate voucher no then it replaced the previous one in the data sheet. But it should prevent duplicate entry of voucher no & serial no.
2) After every data submitted, i've to reset the userform to show the new data in the listbox.
3) My "delete data" button not works.

Sorry to bother you again.

Thanks in advance.
 
Upvote 0

Forum statistics

Threads
1,223,895
Messages
6,175,257
Members
452,625
Latest member
saadat28

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
Back
Top