Move a cell row to another worksheet based on cell value

AudreyKay

AudreyKay

New member
Joined
Nov 4, 2015
Messages
4
Reaction score
0
Points
0
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.)
 
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
 

Attachments

  • AudreyKay(Transfer data by autofilter).xlsm
    17.3 KB · Views: 1,254
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.
 

Attachments

  • Follow Up ReportExample.xlsm
    17.5 KB · Views: 483
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.
 

Attachments

  • AudreyKay2(Transfer table data).xlsm
    24 KB · Views: 1,181
Hello Audrey,

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

Cheerio,
vcoolio.
 
vcoolio said:
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
Click to expand...


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
 

Attachments

  • Screenshot.PNG
    Screenshot.PNG
    9.8 KB · Views: 158
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()

[COLOR=#ff0000]Dim lr As Long[/COLOR]

Application.ScreenUpdating = False
Application.DisplayAlerts = False

         Range("I1", Range("I" & Rows.Count).End(xlUp)).AutoFilter 1, "Closed"
        [COLOR=#ff0000] lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
         If lr > 1 Then[/COLOR]
         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.
 
You must log in or register to reply here.
Back
Top