Page 1 of 2 12 LastLast
Results 1 to 15 of 20
  1. #1
    New Lounger
    Join Date
    Mar 2013
    Location
    Michigan
    Posts
    14
    Thanks
    5
    Thanked 1 Time in 1 Post

    Question Conditional move of row from sheet to sheet

    Office 2010:
    I want to move the entire row of data to a different sheet based on a condition in row L.

    Example: 5 conditions exist:
    Blank - row stays on main sheet (Message Board)
    C - upon user entering/selecting "C" entire row moves from sheet Message Board to sheet COMPLETE
    D - upon user entering/selecting "D" entire row moves from sheet Message Board to sheet DISQUALIFIED
    I - upon user entering/selecting "I" entire row moves from sheet Message Board to sheet INQUIRY ONLY
    A - upon user entering/selecting "A" entire row moves from sheet Message Board to sheet ABANDONED

    I'd want to be sure this code or macro that is recommended does not execute every time it sees these letters in the spreadsheet - only executes when C D I or A appear in column L
    Last edited by ShannyR; 2013-03-20 at 14:21. Reason: clarification

  2. The Following User Says Thank You to ShannyR For This Useful Post:

    kaybee (2014-03-06)

  3. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,409
    Thanks
    208
    Thanked 834 Times in 767 Posts
    Shanny,

    This was a tricky one indeed! I tried doing it all in the worksheet_change event but Excel would have none of that since I wanted to change to different sheets while in the event handler. What I had to do was to split the work between the Worksheet_Change event handler and a regular module to do the actual work. I also had to turn off Events while the regular module was working to prevent the handler from being called by the copying/deleting work and causing an error.

    Event Handler Code:
    Code:
    Option Explicit
    
    Private Sub Worksheet_Change(ByVal Target As Range)
    
       Dim isect  As Range
          
       Set isect = Application.Intersect(Range("L:L"), Target)
       If isect Is Nothing Then
    '     MsgBox "Ranges do not intersect"
       Else
          Application.EnableEvents = False
          MoveDeleteRecord Target
          Application.EnableEvents = True
       End If
    
    End Sub
    Regular Module Code:
    Code:
    Option Explicit
    
    Sub MoveDeleteRecord(Target As Range)
    
       Dim oDestSheet   As Worksheet
       Dim oSourcesheet As Worksheet
       Dim lCurRow      As Long
    
          Application.ScreenUpdating = False
          Set oSourcesheet = ActiveSheet
          lCurRow = Target.Row
    
          Select Case UCase(Target.Value)
                Case "C"
                    Set oDestSheet = Sheets("Complete")
                Case "D"
                    Set oDestSheet = Sheets("Disqualified")
                Case "I"
                    Set oDestSheet = Sheets("Inquiry Only")
                Case "A"
                    Set oDestSheet = Sheets("Abandoned")
                Case Else: Exit Sub
          End Select
       
          oDestSheet.Activate
          [A1].End(xlDown).Select
          
          If ActiveCell.Row = Rows.Count Then
            [a2].Select
          Else
           Selection.Offset(1, 0).Select
          End If
          
          oSourcesheet.Activate
          Rows(lCurRow).EntireRow.Copy
          oDestSheet.Activate
          ActiveSheet.Paste
          Application.CutCopyMode = False
          
          oSourcesheet.Activate
          Rows(lCurRow).EntireRow.Delete
    
    End Sub
    HTH
    Attached Files Attached Files
    Last edited by RetiredGeek; 2013-03-20 at 14:31.
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  4. The Following User Says Thank You to RetiredGeek For This Useful Post:

    ShannyR (2013-03-20)

  5. #3
    New Lounger
    Join Date
    Mar 2013
    Location
    Michigan
    Posts
    14
    Thanks
    5
    Thanked 1 Time in 1 Post

    response to RG THANKS - I need further assistance if you please

    RG - I see it worked on your sample. I can't seem to follow how to follow this with mine. I don't see all of the code in your sample. I should have attached my sheet for you to use as the model. Can you help me understand where all the code is placed for the outcome you show?

    I am new to this, I believe I uploaded a file this time. Can you see it?
    Last edited by RetiredGeek; 2013-03-20 at 17:01. Reason: Removed attachment per user request.

  6. #4
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,409
    Thanks
    208
    Thanked 834 Times in 767 Posts
    Shanny,

    The MoveDeleteRecord code goes in a standard Module {you may have to click Insert, Module to get one}.
    CodeLocation1.JPG

    The Worksheet_Change code goes in the MessageBoard sheet module see 1st highlight above.

    I'll add your module if you can't load the code using the above description.

    HTH

    Here's your file w/code:
    Attachment 34666
    Last edited by RetiredGeek; 2013-03-20 at 17:00.
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  7. The Following User Says Thank You to RetiredGeek For This Useful Post:

    ShannyR (2013-03-20)

  8. #5
    New Lounger
    Join Date
    Mar 2013
    Location
    Michigan
    Posts
    14
    Thanks
    5
    Thanked 1 Time in 1 Post
    RG,

    you are my friggin H E R O! THANK YOU THANK YOU THANK YOU

  9. #6
    New Lounger
    Join Date
    Mar 2013
    Location
    Michigan
    Posts
    14
    Thanks
    5
    Thanked 1 Time in 1 Post
    NOW....one final request - can we make my spreadsheet disappear from this board but leave the code? there are a few things in there that I don't want joe public to see.

  10. #7
    New Lounger
    Join Date
    Mar 2013
    Location
    Michigan
    Posts
    14
    Thanks
    5
    Thanked 1 Time in 1 Post
    ah, fix one thing, break another. For some reason, my date/timestamp coding isn't working now. What am I missing? This is what I have on the VB code for sheet 1:

    Option Explicit

    Private Sub Worksheet_Change(ByVal Target As Range)

    Dim isect As Range

    Set isect = Application.Intersect(Range("L:L"), Target)
    If isect Is Nothing Then
    ' MsgBox "Ranges do not intersect"
    Else
    Application.EnableEvents = False
    MoveDeleteRecord Target
    Application.EnableEvents = True
    End If




    If Target.Cells.Count > 1 Then Exit Sub

    If Not Intersect(Target, Range("A4:A50")) Is Nothing Then

    With Target(1, 2)

    .Value = Now

    End With

    End If

    End Sub

  11. #8
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,409
    Thanks
    208
    Thanked 834 Times in 767 Posts
    Shanny,

    The workbooks have been removed.

    You can't add you code where you have above. It needs to be added before the record is copied and deleted in the main module.

    I'll work on it.
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  12. The Following User Says Thank You to RetiredGeek For This Useful Post:

    ShannyR (2013-03-20)

  13. #9
    New Lounger
    Join Date
    Mar 2013
    Location
    Michigan
    Posts
    14
    Thanks
    5
    Thanked 1 Time in 1 Post
    Thanks RG! My email is {Removed from post for security} if you could send me the file. Thanks again! you rock!

    I removed your email address ...not a good idea. Use the Private Message feature to send email addresses to another user then only they get it not the whole world!
    Last edited by RetiredGeek; 2013-03-20 at 18:02. Reason: Remove poster's email address.

  14. #10
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,409
    Thanks
    208
    Thanked 834 Times in 767 Posts
    Shanny,

    Here's code to REPLACE the code in Module1:
    Code:
    Option Explicit
    
    Sub MoveDeleteRecord(Target As Range)
    
       Dim oDestSheet   As Worksheet
       Dim oSourcesheet As Worksheet
       Dim lCurRow      As Long
    
          Application.ScreenUpdating = False
          Set oSourcesheet = ActiveSheet
          lCurRow = Target.Row
    
          Select Case UCase(Target.Value)
                Case "C"
                    Set oDestSheet = Sheets("Completed")
                Case "D"
                    Set oDestSheet = Sheets("Disqualified")
                Case "I"
                    Set oDestSheet = Sheets("Inquiry Only")
                Case "A"
                    Set oDestSheet = Sheets("Abandoned")
                Case Else: Exit Sub
          End Select
       
          With Cells(lCurRow, 13)
              .Value = Now()
              .NumberFormat = "mm/dd/yy hh:mm tt"
          End With
          
          With Cells(lCurRow, 14)
              .FormulaR1C1 = "=DateDif(RC2,RC13," & Chr(34) & "D" & Chr(34) & ")"
              .NumberFormat = "General"
          End With
          
          oDestSheet.Activate
          [A1].End(xlDown).Select
          
          If ActiveCell.Row = Rows.Count Then
            [a2].Select
          Else
           Selection.Offset(1, 0).Select
          End If
          
          oSourcesheet.Activate
          Rows(lCurRow).EntireRow.Copy
          oDestSheet.Activate
          ActiveSheet.Paste
          Application.CutCopyMode = False
          
          oSourcesheet.Activate
          Rows(lCurRow).EntireRow.Delete
    
    End Sub
    This code will fillin the current date/time in Col M and enter a formula in Col N that will calculate the number of Days it took to resolve. If you want finer control you'll have to play with the dates in the VBA code and construct a string that contains something like " Months 1, Days 3, Hours 2". I know it can be done but I'm brain dead right now and can't remember how.

    Remember to delete the code you added to the Worksheet_Change code in Sheet1!

    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  15. #11
    New Lounger
    Join Date
    Mar 2013
    Location
    Michigan
    Posts
    14
    Thanks
    5
    Thanked 1 Time in 1 Post
    ah, I've done something wrong. The date/timestamp in column B triggers from the intake worker selecting their name in column A. That was working, but isn't now.

    I think I did what you indicated above, but it errors out upon executing the "move" feature, and the date/timestamp in column B is not working. I think I am brain dead for the night too.

    I guess I will work on my taxes now. (how dangerous is that!)

    I hope to see you in this forum tomorrow RG!

  16. #12
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,409
    Thanks
    208
    Thanked 834 Times in 767 Posts
    Shanny,

    Replace the code in Sheet1 (MESSAGE BOARD) with the following:
    Code:
    Option Explicit
    
    Private Sub Worksheet_Change(ByVal Target As Range)
    
       Dim iSect  As Range
       
       Set iSect = Application.Intersect(Range("A:A"), Target)
          If iSect Is Nothing Then
          Else
            With Target.Offset(0, 1)
              .Value = Now()
              .NumberFormat = "mm/dd/yy hh:mm tt"
            End With
            Target.Offset(0, 2).Select
            Exit Sub
          End If
          
       Set iSect = Application.Intersect(Range("L:L"), Target)
       If iSect Is Nothing Then
    '     MsgBox "Ranges do not intersect"
       Else
          Application.EnableEvents = False
          MoveDeleteRecord Target
          Application.EnableEvents = True
       End If
    
    End Sub   'Worksheet_Change()
    This will automatically enter the date/time in Col B and move the selected sell to Col C for the user to continue inputting with the Patient Name. HTH
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  17. The Following User Says Thank You to RetiredGeek For This Useful Post:

    ShannyR (2013-03-21)

  18. #13
    New Lounger
    Join Date
    Mar 2013
    Location
    Michigan
    Posts
    14
    Thanks
    5
    Thanked 1 Time in 1 Post
    RG, I suspect you do this to keep that brain sharp in your retirement. I gotta say IT'S WORKING! You are one SHARP guy!

    Thanks SO much for your help.

    This last code worked stellar. The calculation at the end for duration of time passed is putting 0, but everything else is working!

    can you tell me what the tt after the timestamp means?

  19. #14
    New Lounger
    Join Date
    Mar 2013
    Location
    Michigan
    Posts
    14
    Thanks
    5
    Thanked 1 Time in 1 Post
    RG,

    I appreciate you sticking with me on this - I suspect after exhaustion yesterday, it nagged you and you burned the nighttime oil for me. I really appreciate that! This matrix will help us track a LOT of sick people and hopefully get them to help much quicker.

    Now - next question is: can I apply the "Module 1" code to the other sheets or should I create a module for each sheet and copy the code in? (in the event the intake worker puts the wrong letter and wants it moved to a different sheet)

  20. #15
    New Lounger
    Join Date
    Mar 2013
    Location
    Michigan
    Posts
    14
    Thanks
    5
    Thanked 1 Time in 1 Post
    AND, can we add to the code that if it is blank (null) it goes to the MESSAGE BOARD sheet....

Page 1 of 2 12 LastLast

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •