Macro to Saving Data Before Deleting

[coliervile]

Good morning/afternoon to Y'ALL :hi: . Is it possible to save a row of data that you're getting ready to delete before you actually delete it?

The following macro allows the user to select a row of data from a listbox (ListBox1) on userform "frmRequest" and then delete the data from worksheet "Leave Request". I want to save the information to another worksheet "Deleted Data" before it's actually deleted. The NEW worksheet "Deleted Data" has 5 columns "A" to "E" and headers in "A1" to "E1" and the saved data starts in row 2 "A2" on down.

OR IS THERE AN EASIER WAY TO ACCOMPLISH THIS???

Private Sub CommandButton1_Click()
Dim mpLastRow As Long

Application.EnableEvents = False

With frmRequest.ListBox1
'Check for selected item
If (.Value <> vbNullString) Then

'If more then one data rows
mpLastRow = xlLastRow("Leave Request")
If .ListIndex >= 0 Then

Range(.RowSource)(.ListIndex + 1, 1).EntireRow.Delete
'Update listbox
.RowSource = "'Leave Request'!A2:E" & mpLastRow
Else

MsgBox "Please Select Data"
End If
End If
End With

Application.EnableEvents = True

Unload Me
End Sub


























</IMG>

[Bob Phillips]

Untested (as ever)




Private Sub CommandButton1_Click()
Dim mpLastRow As Long

Application.EnableEvents = False

With frmRequest.ListBox1
'Check for selected item
If (.Value <> vbNullString) Then

'If more then one data rows
mpLastRow = xlLastRow("Leave Request")
If .ListIndex >= 0 Then

Range(.RowSource)(.ListIndex + 1, 1).Resize(, 5).Copy Worksheets("Deleted Data").Range("A1").End(xlDown).Offset(1, 0)
Range(.RowSource)(.ListIndex + 1, 1).EntireRow.Delete
'Update listbox
.RowSource = "'Leave Request'!A2:E" & mpLastRow
Else

MsgBox "Please Select Data"
End If
End If
End With

Application.EnableEvents = True

Unload Me
End Sub

[Soul777Toast]

Hi!

Why don't you just cut and paste the data, instead of deleting it?

instead of


Range(.RowSource)(.ListIndex +1, 1).EntireRow.Delete

Try


' insert into variable declarations
Dim NextEntry as Long

' Cut Selected Data
Range(.RowSource)(.ListIndex +1, 1).EntireRow.Select
Selection.Cut

' Find Next Available Row in Deleted Data Sheet. If Deleted Data is in another workbook, instead of Sheets("Deleted Data"),
'use Workbooks("workbookname").Sheets("Deleted Data")
With Sheets("Deleted Data")
NextEntry = .Range("A:A").Find(What:="*", After:=.Range("A1"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row + 1

'Paste In Data
.Range(Cells(NextEntry, "A").Select
Selection.Paste
end with


Hope this helps!

[coliervile]

Good afternoon Bob. I did run the suggested macro and ran into this error:

Run-time error '1004":
Application-defined or object-defined error
(the RED colored area in the code)

Private Sub CommandButton1_Click()
Dim mpLastRow As Long

Application.EnableEvents = False

With frmRequest.ListBox1
'Check for selected item
If (.Value <> vbNullString) Then

'If more then one data rows
mpLastRow = xlLastRow("Leave Request")
If .ListIndex >= 0 Then

Range(.RowSource)(.ListIndex + 1, 1).Resize(, 5).Copy Worksheets("Deleted Data").Range("A1").End(xlDown).Offset(1, 0)
Range(.RowSource)(.ListIndex + 1, 1).EntireRow.Delete
'Update listbox
.RowSource = "'Leave Request'!A2:E" & mpLastRow
Else

MsgBox "Please Select Data"
End If
End If
End With

Application.EnableEvents = True

Unload Me
End Sub

[Bob Phillips]

Try this instead



Range(.RowSource)(.ListIndex + 1, 1).Resize(, 5).Copy Worksheets("Deleted Data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

[coliervile]

Thanks for your reply Soul777Toast. I ran your macro as well and ran into a complile error:

The line colored in Red was colored red when I added your coding to the macro.

The area colored was highlighted when I ran the Debug.

' insert into variable declarations
Dim NextEntry As Long

' Cut Selected Data
Range(.RowSource)(.ListIndex +1, 1).EntireRow.Select
Selection.Cut

' Find Next Available Row in Deleted Data Sheet. If Deleted Data is in another workbook, instead of Sheets("Deleted Data"),
'use Workbooks("workbookname").Sheets("Deleted Data")
With Sheets("Deleted Data")
NextEntry = .Range("A:A").Find(What:="*", After:=.Range("A1"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row + 1

'Paste In Data
.Range(Cells(NextEntry, "A").Select
Selection.Paste
End With

[coliervile]

"XLD" thank you sir that did the trick. Have a great day.