Results 1 to 8 of 8

Thread: Move a cell row to another worksheet based on cell value

  1. #1

    Move a cell row to another worksheet based on cell value



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hello!

    VBA Virgin here.

    I have a worksheet that I've made to track progress on certain tasks. I would like to have a Macro/VBA code that would automatically move a cell row from the "Open Cases" Worksheet to the "Closed Cases" worksheet. The value that would determine this change would be in column I, and the text value would be 'Closed'

    I'm pretty savvy when it comes to excel formulas, but am at a complete and utter loss when it comes to working with Macros or VBA. So please explain your answers in the simplest way possible. (And maybe even explain it so I can understand for any other VBA work I might need to do.)

  2. #2
    Acolyte vcoolio's Avatar
    Join Date
    Jan 2016
    Posts
    27
    Articles
    0
    Excel Version
    2016
    Hello Audrey,

    The following code should do the task for you:-

    Code:
    Sub TransferData() 'The sub routine name.
    
    Application.ScreenUpdating = False  '---->Prevents screen flickering as the code executes.
    Application.DisplayAlerts = False  '---->Prevents warning "pop-ups" from appearing.
    
             Range("I1", Range("I" & Rows.Count).End(xlUp)).AutoFilter 1, "Closed"  'Filters Column I for "Closed"
             Range("A2", Range("N" & Rows.Count).End(xlUp)).Copy Sheet2.Range("A" & Rows.Count).End(xlUp)(2)  ' Copies row data from Columns A - N & transfers it _
    to sheet2 into the next available row.
             Range("A2", Range("N" & Rows.Count).End(xlUp)).Delete '---->Deletes the "used" data from sheet1. This also prevents duplicates in sheet2.
       [I1].AutoFilter  'Turns off the autofilter.
       
    Application.CutCopyMode = False  '---->Prevents the "marching ants" from bordering the copied rows of data.
    Application.DisplayAlerts = True   '---->Resets the default.
    Application.ScreenUpdating = True  '---->Resets the default.
    Sheet2.Select '---->Takes you directly to sheet2 (Closed Cases).
    
    End Sub  'Closes the sub routine.
    As you can see, I've added some notes beside each line of code so that you can understand what the code is doing.

    As I don't know how large your data set is, I've just assumed that it stretches from Column A to Column N. Change this to suit yourself.

    I've attached my test work book for you to peruse. Click on the Transfer Data button to see the code work.

    I hope that this helps.

    Cheerio,
    vcoolio
    Attached Files Attached Files

  3. #3
    I get a runtime error 1004 and this string of code is highlighted:

    Sub TransferData() 'The sub routine name.


    Application.ScreenUpdating = False '---->Prevents screen flickering as the code executes.
    Application.DisplayAlerts = False '---->Prevents warning "pop-ups" from appearing.


    Range("I1", Range("I" & Rows.Count).End(xlUp)).AutoFilter 1, "Closed" 'Filters Column I for "Closed"
    Range("A2", Range("N" & Rows.Count).End(xlUp)).Copy Sheet2.Range("A" & Rows.Count).End(xlUp)(2) ' Copies row data from Columns A - N & transfers it _
    to sheet2 into the next available row.
    Range("A2", Range("N" & Rows.Count).End(xlUp)).Delete '---->Deletes the "used" data from sheet1. This also prevents duplicates in sheet2.
    [I1].AutoFilter 'Turns off the autofilter.

    Application.CutCopyMode = False '---->Prevents the "marching ants" from bordering the copied rows of data.
    Application.DisplayAlerts = True '---->Resets the default.
    Application.ScreenUpdating = True '---->Resets the default.
    Sheet2.Select '---->Takes you directly to sheet2 (Closed Cases).


    End Sub 'Closes the sub routine.
    Attached Files Attached Files

  4. #4
    Acolyte vcoolio's Avatar
    Join Date
    Jan 2016
    Posts
    27
    Articles
    0
    Excel Version
    2016
    Hello Audrey,

    As you didn't supply your sample work book in your first post, a couple of things have come to light:-

    - The ranges between the code supplied to you and your data set don't match. Your data starts in A5 and stretches out to Column K. Hence the error.
    - Your data set is in table format which normal code won't adapt to. Hence we need to reference ListObjects.

    Following is a revised code to cover the above:-
    Code:
    Sub TransferData()
    
    Application.ScreenUpdating = False
    
            Dim i As Integer
            Dim lr As Long
    
    lr = Range("A" & Rows.Count).End(xlUp).Row
    
    Sheet2.ListObjects("Table2").Unlist
    
            For i = lr To 6 Step -1
            If Cells(i, 9).Value = "Closed" Then
            Range(Cells(i, 1), Cells(i, 11)).Copy
            Sheet2.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
            Range(Cells(i, 1), Cells(i, 11)).Delete
        End If
    Next
    
    Sheet2.Columns.AutoFit
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Sheet2.Select
    Sheet2.ListObjects.Add(xlSrcRange, Range("A5:K" & lr), , xlYes).Name = "Table2"
    End Sub
    You could, of course, scrap the table formats (at least in sheet2) and revert to the original code. Just change the cell references to suit.

    It should all be sorted out for you now.

    The updated test work book is attached for your perusal.

    Cheerio,
    vcoolio.
    Attached Files Attached Files

  5. #5
    Thank you so much!

  6. #6
    Acolyte vcoolio's Avatar
    Join Date
    Jan 2016
    Posts
    27
    Articles
    0
    Excel Version
    2016
    Hello Audrey,

    You're welcome. I'm glad that I was able to help you.

    Cheerio,
    vcoolio.

  7. #7
    Quote Originally Posted by vcoolio View Post
    Hello Audrey,

    The following code should do the task for you:-

    Code:
    Sub TransferData() 'The sub routine name.
    
    Application.ScreenUpdating = False  '---->Prevents screen flickering as the code executes.
    Application.DisplayAlerts = False  '---->Prevents warning "pop-ups" from appearing.
    
             Range("I1", Range("I" & Rows.Count).End(xlUp)).AutoFilter 1, "Closed"  'Filters Column I for "Closed"
             Range("A2", Range("N" & Rows.Count).End(xlUp)).Copy Sheet2.Range("A" & Rows.Count).End(xlUp)(2)  ' Copies row data from Columns A - N & transfers it _
    to sheet2 into the next available row.
             Range("A2", Range("N" & Rows.Count).End(xlUp)).Delete '---->Deletes the "used" data from sheet1. This also prevents duplicates in sheet2.
       [I1].AutoFilter  'Turns off the autofilter.
       
    Application.CutCopyMode = False  '---->Prevents the "marching ants" from bordering the copied rows of data.
    Application.DisplayAlerts = True   '---->Resets the default.
    Application.ScreenUpdating = True  '---->Resets the default.
    Sheet2.Select '---->Takes you directly to sheet2 (Closed Cases).
    
    End Sub  'Closes the sub routine.
    As you can see, I've added some notes beside each line of code so that you can understand what the code is doing.

    As I don't know how large your data set is, I've just assumed that it stretches from Column A to Column N. Change this to suit yourself.

    I've attached my test work book for you to peruse. Click on the Transfer Data button to see the code work.

    I hope that this helps.

    Cheerio,
    vcoolio

    Hi,

    I had a similar query and tried the sample spreadsheet for my data transfer, which works fine so thank you very much.

    However I've noticed that if the "Transfer Data" button is clicked accidentally or when there's no data in Column i that meets the transfer criteria, it transfers the entire top row including the 'Transfer Data' button to Sheet 2.

    I'm attaching a screenshot.

    Is there a way of fixing this? Its just that the spreadsheet at our end will be used by various people in the team with varied levels of IT skills.


    Thanks

    AFSA
    Attached Thumbnails Attached Thumbnails Click image for larger version. 

Name:	Screenshot.PNG 
Views:	84 
Size:	9.8 KB 
ID:	7659  

  8. #8
    Acolyte vcoolio's Avatar
    Join Date
    Jan 2016
    Posts
    27
    Articles
    0
    Excel Version
    2016
    Hello Afsa,

    Well, this is weird. I only this day received notification that you had on 6/12/2017 posted to this now very old thread! I have no idea why this happened.

    However, just in case you are still out there (and it just may no longer matter to you now), the fix to your little issue is a matter of qualifying that a last row exists after rows are deleted. So, the code amended as follows should do the trick:-
    Code:
    Sub TransferData()
    
    Dim lr As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
             Range("I1", Range("I" & Rows.Count).End(xlUp)).AutoFilter 1, "Closed"
             lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
             If lr > 1 Then
             Range("A2", Range("N" & Rows.Count).End(xlUp)).Copy Sheet2.Range("A" & Rows.Count).End(xlUp)(2)
             Range("A2", Range("N" & Rows.Count).End(xlUp)).Delete
             End If
             [I1].AutoFilter
       
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    End Sub
    The lines in red font are the additions.

    I hope that this helps.

    Cheerio,
    vcoolio.

Posting Permissions

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