Solved

Cut Row and paste in a different Sheet when Doing double click.

Posted on 2009-03-29
4
324 Views
Last Modified: 2013-11-10
Hi,

I have the following code in sheet "ENTREGAS" that works as a Check box.

What I need to add to the code is the action to cut the ROW where I´m doing the doubleclick and paste it to Sheet "ENTREGADOS".

CODE:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     Dim lngRow As Long
     'Limit Target count to 1
    If Target.Count > 1 Then Exit Sub
     'Isolate Target to a specific range
    If Intersect(Target, Range("tildes")) Is Nothing Then Exit Sub
    lngRow = Target.Row
     'set Target font tp "marlett"
    Target.Font.Name = "marlett"
     'Check value of target
    If Target.Value <> "a" Then
        Target.Value = "a" 'Sets target Value = "a"
        ' check it's column B
     
   
        Cancel = True
        Exit Sub
    End If
    If Target.Value = "a" Then
        Target.ClearContents 'Sets Target Value = ""
         With Sheets("ENTREGAS")
            .Cells(Target.Row, Target.Column + 1).Value = ""
         
        End With
       
        Cancel = True
        Exit Sub
    End If
End Sub


Could you help me please ?

Regards,
Roberto.
0
Comment
Question by:Pabilio
  • 2
  • 2
4 Comments
 
LVL 50

Expert Comment

by:Dave Brett
ID: 24015012
something like this - see sample file
Cheers
Dave

Option Explicit
 

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim ws As Worksheet, rng1 As Range

    Cancel = True

    Set ws = Sheets("ENTREGADOS")

    Set rng1 = ws.Cells(Rows.Count, "A").End(xlUp)

    If rng1.Row <> vbNullString Then Set rng1 = rng1.Offset(1, 0)

    With Target

        .EntireRow.Copy rng1

        .EntireRow.Delete shift:=xlUp

    End With

End Sub

Open in new window

cutnpaste.xls
0
 
LVL 5

Author Comment

by:Pabilio
ID: 24015078
hi Dave,

The code gave me error 13
And highlighted line 8:  If rng1.Row <> vbNullString

I forgot to say in my question that the code must run when doing double click only in any cell in column G (Range tildes is from G2 to G2000)

Thank you for your help.

Roberto.
0
 
LVL 50

Accepted Solution

by:
Dave Brett earned 500 total points
ID: 24015108
Take 2 - with Column G restriction added
Cheers
Dave
 
 



Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim ws As Worksheet, rng1 As Range

    Cancel = True

    If Target.Column <> 7 Then Exit Sub

    Set ws = Sheets("ENTREGADOS")

    Set rng1 = ws.Cells(Rows.Count, "A").End(xlUp)

    If rng1.Value <> vbNullString Then Set rng1 = rng1.Offset(1, 0)

    With Target

        .EntireRow.Copy rng1

        .EntireRow.Delete shift:=xlUp

    End With

End Sub

Open in new window

0
 
LVL 5

Author Closing Comment

by:Pabilio
ID: 31564113
Take 2 is the one....
Just perfect !!!
Thank you Dave.
P.S.: Dave if you have time, please have a look at this question:
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_24254306.html
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A short article about a problem I had getting the GPS LocationListener working.
Whether you’re a college noob or a soon-to-be pro, these tips are sure to help you in your journey to becoming a programming ninja and stand out from the crowd.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

920 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now