Excel VBA User Form ( Need Help here please )

[mikekhel1987]

I have created a userform ( Delete userform to be specific ) on my employee database. If there is a resign employee we want to delete it in our database using the form. I just want to ask if every time that there is a resign employee I can copy first the whole data of the employee to another worksheet for future reference before deleting it the database? below is the code that i used in the delete userform button.

Private Sub cmdDelete_Click()
'declare the variables
Dim findvalue As Range
Dim cDelete As VbMsgBoxResult
Dim cNum As Integer
Dim DataSH As Worksheet
Set DataSH = Sheet2
Dim x As Integer

'error statement
On Error GoTo errHandler:
'hold in memory and stop screen flicker
Application.ScreenUpdating = False

'check for values
If Emp1.Value = "" Or Emp2.Value = "" Then
MsgBox "There is not data to delete"
Exit Sub
End If

'give the user a chance to change their mind
cDelete = MsgBox("Are you sure that you want to delete this employee?", _
vbYesNo + vbDefaultButton2, "Are you sure????")
If cDelete = vbYes Then
'find the row
Set findvalue = DataSH.Range("B:B").Find(What:=Me.Emp1.Value, _
LookIn:=xlValues, LookAt:=xlWhole)
'delete the entire row
findvalue.EntireRow.Delete
End If

'clear the controls
cNum = 14
For x = 1 To cNum
Me.Controls("Emp" & x).Value = ""
Next

'unprotect all sheets for the advanced filter
'Unprotect_All
'filter the data
DataSH.Range("B8").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("Data!$S$8:$S$9"), CopyToRange:=Range("Data!$U$8:$AH$8"), _
Unique:=False

'if no data exists then clear the rowsource
If DataSH.Range("U9").Value = "" Then
lstEmployee.RowSource = ""
Else
'add the filtered data to the rowsource
lstEmployee.RowSource = DataSH.Range("outdata").Address(external:=True)
End If

'sort the data by "Surname"
DataSH.Select
With DataSH
.Range("B9:O10000").Sort Key1:=Range("C9"), Order1:=xlAscending, Header:=xlGuess
End With

'Protect all sheets
'Protect_All
'return to sheet
Sheet1.Select
'error block
On Error GoTo 0
Exit Sub

errHandler:
'Protect all sheets if error occurs
'Protect_All
'show error information in a messagebox
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " & _
Err.Number & vbCrLf & Err.Description & vbCrLf & "Please notify the administrator"


End Sub

I hope you can help me on this. Thank you in advance. any help will be very much appreciated.

[mancubus]

welcome to the forum.

please use code tags when posting your code.
from FAQ:
1. paste your code into the text area
2. highlight (select) the code
3. click the # button
http://www.vbaexpress.com/forum/faq....q=new_faq_item
title: How do I post code samples?



add below line

findvalue.EntireRow.Copy Worksheets("DeletedRecords").Range("A" & Rows.Count).End(xlUp).Offset(1)

before this line

findvalue.EntireRow.Delete

like:

If cDelete = vbYes Then
    'find the row
    Set findvalue = DataSH.Range("B:B").Find(What:=Me.Emp1.Value, _
    LookIn:=xlValues, LookAt:=xlWhole)
    'copy entire row before deleting
    findvalue.EntireRow.Copy Worksheets("DeletedRecords").Range("A" & Rows.Count).End(xlUp).Offset(1)
    'delete the entire row
    findvalue.EntireRow.Delete
End If

change "DeletedRecords" to suit.

[mikekhel1987]

Hi Mancubus sorry if I posted it the wrong way. By the way thank you for the help it worked but there is still a problem. If I deleted an employee the details from the database will go to the Suit Sheet B2:O2 but if I delete another employee it will just overwrite the data in B2:O2. Is there a way that every time that I delete it will go to the next blank row, for example if there is a data in B2:O2 and if I deleted another employee the next deleted employee detail will go to B3:O3.

Thank You so much in advance for your help.

[mancubus]

you are welcome.



Worksheets("DeletedRecords").Range("A" & Rows.Count).End(xlUp)............... Offset(1)
-------------------------------------------------------------------------- ................------------
Go up to last nonblank cell in Column A in sheet ................................ ....... move 1 row down


you may need to change "A" to the column letter in which deleted records will be copied.

Worksheets("DeletedRecords").Range("B" & Rows.Count).End(xlUp).Offset(1)

[mikekhel1987]

Hi Mancubus

Just did your advised but it still overwrite the details
But when I changed this part "Offset(1)" to "Offset(2) it will go to the next row down and when I delete again it will overwrite again the detail in the second row.

I Hope there's still other way. Thank You.

[mikekhel1987]

Hi Mancubus

Sorry I got confused on the code. I has worked perfectly now. Thank You so much for your help.

[mancubus]

you are welcome.
pls mark the thread as solved from Thread Tools (top right corner of the first message).