VBA help

[redspanna]

Hi all,

I have this code that was kindly given by a post on here several months back and I now wish to change it slightly, the user double clicks on a text string and then after a popup checking for varification the whole line of data is removed.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
rspn = MsgBox("You have chosen to delete " & Cells(Target.Row, 2) & " " & Cells(Target.Row, 3) & Chr(10) & "Is that correct?", vbYesNo)
If rspn = vbYes Then Target.EntireRow.Delete
End Sub

the change to the code I would like is this:_

before the whole line is removed can it first be copied into next available row in "database" sheet. Once copied then the selected line (ie the original code) can be removed.

I'm guessing that the

if rspn=vbYes Then Target.EntireRow.Delete

would be changed....but not sure how

many thanks in advance

 

[VoG]

Try

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
rspn = MsgBox("You have chosen to delete " & Cells(Target.Row, 2) & " " & Cells(Target.Row, 3) & Chr(10) & "Is that correct?", vbYesNo)
If rspn = vbYes Then
    Target.EntireRow.Copy Destination:=Sheets("Database").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Target.EntireRow.Delete
End If
End Sub

 

[redspanna]

Hi

Thanks for help with code, however the copied text that is going into the database sheet is replacing the last row...where as it should be placed into next available row so that a database is kinda created.

Just one other additional request...

can the copied text also be pasted into the database sheet with the font at size 8 and black in colour??

thanks again

 

[VoG]

I'm guessing that there is nothing in column A. Try this

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim LR As Long
Cancel = True
rspn = MsgBox("You have chosen to delete " & Cells(Target.Row, 2) & " " & Cells(Target.Row, 3) & Chr(10) & "Is that correct?", vbYesNo)
If rspn = vbYes Then
    LR = Sheets("Database").Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    Target.EntireRow.Copy Destination:=Sheets("Database").Range("A" & LR + 1)
    With Sheets("Database").Rows(LR + 1)
        .Font.Color = xlAutomatic
        .Font.Size = 8
    End With
    Target.EntireRow.Delete
End If
End Sub

 

[redspanna]

Many thanks - perfect !!