• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Automatically cut a row to another worksheet based on cell value

G

gumbles

New Member
Hi there,


I have a worksheet "Pending" that contains all of the current pending documents for the department. Column "C" is for completion date, and when I enter a date in here I would like the entire row to be cut and pasted into the worksheet "Approved". The row spans from "A:I".


I have named column "C" as "rngTrigger" and the destination row in worksheet "Approved" as "rngDest".


I have had several attempts myself but my VB skills are rather limited.


Any help would be grate.
 
Hi,


Can you please try the below code(Insert a module and paste the code). It will select the active row and move the data to approved sheet. So as soon as you entered date and you want to move the particular row from pending to approved sheet is you to run this macro (ALT+F8). Suppose you want the row # 5 to be moved from pending to approved is what you have do is select any cell from row #5 of pending and run macro.


Sub copyandpaste()

Worksheets("Pending").Select

Rows(ActiveCell.Row).Copy

Worksheets("Approved").Select

Range("A10000").End(xlUp).Offset(1, 0).Select

ActiveSheet.Paste

Range("A2").Select

Worksheets("Pending").Select

Application.CutCopyMode = False

Range("A1").Select

End Sub


Thanks,

Suresh Kumar S
 
Thanks Suresh,


I have pasted your code into the module, but i am getting the VB error "400"?


I have to idea what this means?


Also, I know this is a lazy request, but some times there may be alot of documents that are approved at once and cutting them all manually could take up alot of my time, so i was wondering if its possible to make the macro perform automatically. Something like "if cell in column "C" isDate then".


Thanks
 
Hi Gumbles,


You can upload the same workbooks from the below links.


http://www.speedyshare.com/

http://www.2shared.com/


Thanks,

Suresh Kumar S
 
I'm afraid my company internet filter wont allow me to access either of the websites. I can upload it when I get home but that's not till the end of the day. :(


Ill show you what I came up with using other online explanations, however I was not able to work out why it didnt work:


Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngDest As Range

Set rngDest = Worksheets("Pending").Range("rngDest")


' Limit the trap area to range of cells in which completed dates are entered as defined above

If Not Intersect(Target, Range("rngTrigger")) Is Nothing Then


' Only trigger if the value entred is a date or is recognizable as a valid date

If IsDate(Target) Then

'Ensure subsequent deletion of 'moved' row does NOT cause the Change Event to run again and get itself in a loop!

Application.EnableEvents = False

Target.EntireRow.Select

Selection.Cut

rngDest.Insert Shift:=xlDown

Selection.Delete

' Reset EnableEvents

Application.EnableEvents = True

End If

End If


End Sub


Gumbles
 
Hi gumbles,


Can you please check the attached file..


https://dl.dropbox.com/u/78831150/Excel/Automatically%20cut%20a%20row%20to%20another%20worksheet%20based%20on%20cell%20value%20%28gumbles%29.xlsm


PS: I wish your company firewall will allow me to enter.. otherwise..

Please have a look at the below coding..

[pre]
Code: 
'-- Place the below code in (Pending Sheet Module)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDest As Range
Set rngDest = Worksheets("Pending").Range("rngDest")

' Limit the trap area to range of cells in which completed dates are entered as defined above
If Not Intersect(Target, Range("rngDest")) Is Nothing Then

' Only trigger if the value entred is a date or is recognizable as a valid date
If RealDate(Target) Then
'Ensure subsequent deletion of 'moved' row does NOT cause the Change Event to run again and get itself in a loop!
Application.EnableEvents = False
Target.EntireRow.Copy Sheets("Approved").Range("A" & _
Sheets("Approved").Range("A" & Sheets("Approved").Cells.Rows.Count).End(xlUp).Row + 1)
Target.EntireRow.Delete xlShiftUp
Application.EnableEvents = True
End If
End If
End Sub

'Just for extra precusion in case of ISDATE fail.. where 12.50 is also a DATE

Function RealDate(Var As Variant) As Boolean
If IsNumeric(Var) Then
RealDate = False
ElseIf IsDate(Var) Then
RealDate = True
Else
RealDate = False
End If
End Function
[/pre]

Don't forget to set RngDest as Column C:C.. you may reduce it to some minimum cells, if required.


Regards,

Deb
 
Hi Debraj,


Thankyou for the reply, unfortunatly the firewall is being a pig and has rejected your link.


I have tried the code but still nothing. I will post the file here when I am home so that people can look at it to make better sense of my situation.


Thanks,


Gumbles
 
Sorry for the delay, Here is the File.


https://www.dropbox.com/s/pm45yvugwwast1b/Initated%20not%20Approved.xlsx


Still cant get the rows to cut across automatically.


Cheers,


Gumbles
 
Hi gumbles,


Can you please check the below file..

https://dl.dropbox.com/u/78831150/Excel/Initated%20not%20Approved%28gumbles%29.xlsm


Regards,

Deb
 
Hi Debraj,


I now have the file, but when I enter a date into column "C" nothing happens... Is there something I must enable or press to initiate the process?


Regards,

Gumbles
 
You must log in or register to reply here.
Back
Top