Automatically shift a row to another sheet.

Microsoft Excel 2003 (full product)
June 29, 2010 at 03:06:58
Specs: Windows XP
Hi there i really need some help, i have a spreadsheet which has information on my staffs vetting checks.

There are three status, Normal, Pending and Archived. (these are within a column named "Status" (U)).

What i would like to do is get these rows depending on there status to copy onto another sheet within the same worksheet. (they are named 'Normal' 'Pending' 'Archived')

so for example any row who's status is archived needs to copy over to archived but also stay in the main sheet.

Just to add a tad more confusion when there status changes, from Pending to Normal they will need to stay on the main sheet but be deleted off pending when they go to normal. (If you understand this waffle)

PLEASE HELP ME


See More: Automatically shift a row to another sheet.

Report •


#1
June 29, 2010 at 05:56:23
Hi,

Here is a macro that is triggered by any change in data in the status column
This macro has the status data in column U - change as appropriate, in this line:
'set status column (A=1, U=21 etc.)
intStatusCol = 21

Source data is in a worksheet named "Source"
If the data has to be in a different worksheet then do a Find and Replace on the code to change "Source" to the actual worksheet name.

The macro clears existing data on the three worksheets "Normal", "Pending" and "Archived".
It then copies all rows of data to the appropriate sheets.

If a status does not match one of the three known statuses, it puts up a warning message and clears any partially copied data from the three worksheets, and then quits (it identifies the offending row number on the Source worksheet)

As changes made by Macros cannot be undone with the Undo button, test this macro on a copy of your data. Always make a backup of your Workbook before running this macro. This code has only been tested on sample data, and it has not been tested in your environment, so test it on copies of your data to ensure that it works 'as expected'

To enter the code:
Right-click the name tab of the Source worksheet and select 'View Code'
In the Visual Basic window that opens, paste this:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'stop changes made by this macro from re-triggering it
Application.EnableEvents = False

On Error GoTo ErrHnd

Dim intStatusCol As Integer
'set status column (A=1 U=21 etc.)
intStatusCol = 21

'test if changed cell is in status column
If Target.Column = intStatusCol Then
    'a status change has occurred
    Dim rngCell As Range
    Dim rngStart As Range
    Dim rngEnd As Range
    Dim intNoffst As Integer
    Dim intPoffst As Integer
    Dim intAoffst As Integer
    
    'clear existing data
    Worksheets("Archived").Cells.Clear
    Worksheets("Pending").Cells.Clear
    Worksheets("Normal").Cells.Clear
    
    'set source data start row (in column A)
    Set rngStart = Worksheets("Source").Range("A2")
    'find end of source data (in column A)
    Set rngEnd = Worksheets("Source"). _
        Range("A" & CStr(Application.Rows.Count)).End(xlUp)
        
    'set three destination row offsets
    intNoffst = 0
    intPoffst = 0
    intAoffst = 0
    
    'loop through source
    'offset is one less than required column
    For Each rngCell In Worksheets("Source").Range(rngStart, rngEnd)
        Select Case rngCell.Offset(0, intStatusCol - 1).Text
            'copy entire row to appropriate sheet
            Case "Archived"
                rngCell.EntireRow.Copy _
                    Destination:=Worksheets("Archived").Range("A2"). _
                    Offset(intAoffst, 0)
                    intAoffst = intAoffst + 1
            Case "Pending"
                    rngCell.EntireRow.Copy _
                    Destination:=Worksheets("Pending").Range("A2"). _
                    Offset(intPoffst, 0)
                    intPoffst = intPoffst + 1
            Case "Normal"
                    rngCell.EntireRow.Copy _
                    Destination:=Worksheets("Normal").Range("A2"). _
                    Offset(intNoffst, 0)
                    intNoffst = intNoffst + 1
            Case Else
            'clear any partially copied data
            Worksheets("Archived").Cells.Clear
            Worksheets("Pending").Cells.Clear
            Worksheets("Normal").Cells.Clear
            'turn on screen updating
            Application.ScreenUpdating = True
            'reenable events
            Application.EnableEvents = True
            'display warning message
            MsgBox "Row " & rngCell.Row & " does not have a valid status" & _
                vbCrLf & _
                "It has this: " & rngCell.Offset(0, intStatusCol - 1).Text & _
                vbCrLf & "The program will now quit - correct data and try again"
            'quit sub
            Exit Sub
        End Select
    Next rngCell
End If
'reenable events
Application.EnableEvents = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
'turn on screen updating
Application.ScreenUpdating = True
'reenable events
Application.EnableEvents = True
End Sub

Change status column and Source worksheet if required.
From the VB menu select Save and save the worksheet with the new code.
Use Alt+f11 to return to the main Excel Worksheet

Click on a cell containing a status, and click the check mark (tick) next to the formula bar. This should trigger the change event, or just re-enter one of the statuses.
You should get the data on the three named worksheets.
(ensure that the worksheet names exactly match those used in the macro: "Archived", "Pending", "Normal")

Regards


Report •

#2
June 29, 2010 at 06:34:33
Hi thanks for that sounds really good. however i dont really understand the top section about 'Source' and the macro stuff can you please simplify this for me. My excel knowledge is not fabulous.

Report •

#3
June 29, 2010 at 06:59:25
Hi,

Source is just the name of the spreadsheet that contains the data.

If your data (with statuses in column U) is on a worksheet with a different name, the easiest thing to do is to re-name it as "Source" (don't use the double quotes when you enter the name). Right click on the worksheet name tab at the bottom of the worksheet and select 'Rename'

As to the macro:
This is a piece of code written in a version of Visual Basic called Visual Basic for Applications (VBA).
The macro has to be stored somewhere and Excel has several places where macros can be stored. Often macros are run by clicking a button, which in turn runs the VBA code.

In your case we want the code to run automatically every time a status is changed.

Excel has a system of 'Events' which can be used to run macros. In this case we are using the 'Change' event.
The change event is triggered when any data on the spreadsheet changes.
The macro has a means of testing which part of the spreadsheet changed - in this case testing if the change was in a cell in column U.
If the change was anywhere else, the macro just closes, but if the change was in column U, it runs the rest of the macro and copies data to the three spreadsheets.

In summary, name your source worksheet "Source", then copy the macro by right-clicking the name tab again and selecting 'View Code', and paste it into the large code window.
Save the changes.

Make sure you have three other worksheets in the same workbook, named: Normal, Pending and Archived.

Now when you change a status you should see the updated data in the three worksheets.

If your data is now in a worksheet named "Source" and the status is in column U, then you shouldn't have to edit the macro at all, so you don't need to worry about the instructions for editing the macro.

Hope this helps.

Regards


Report •

Related Solutions

#4
June 29, 2010 at 07:21:11
That is incredible. Thank you so much. However, i have missed a few things left that i need putting on it.

For example i had: Normal, Pending and Archived. However i actually need "CRB Pending", "PRE REG", and "CRB Pending" I have made the worksheets but i do not think i will be able to put that into the Macro because, well im just not that clever would it be possible for you to include that, so i can copy it over.


Kind Regards


Report •

#5
June 29, 2010 at 07:22:03
SORRY Just CRB Pending, Reject and PRE REG. ( Typo error)

Report •

#6
June 29, 2010 at 12:53:18
Hi,

Here is what is needed:

1.
Declare or dimension three offset counters
Dim intCPoffst As Integer
Dim intPRoffst As Integer
Dim intREoffst As Integer

2.
Set the initial values of these three counters
intCPoffst = 0
intPRoffst = 0
intREoffst = 0

3.
Replicate the bit of code that does the select and copy,
replacing each with the relevant status word/worksheet name and the relevant offset counter:
Case "CRB Pending"
rngCell.Resize(1, 25).Copy _
Destination:=Worksheets("CRB Pending").Range("A2"). _
Offset(intCPoffst, 0)
intCPoffst = intCPoffst + 1

This bit of code goes in the 'Select' - 'End Select' structure
It can have as many 'Cases' as required.
Notice the 'Case Else' which picks up anything that was not a match in the previous sections.

I have changed the copy a little bit, so that whole rows are not copied, just the data in columns A to Y
That way other data in column Z and beyond is copied with the records - you will see further down why I made this change.

4.
Add the extra 'clear-up' lines
Worksheets("CRB Pending").Cells.Clear
etc.

Here is the full macro.
Please check that the new statuses I have included are spelt exactly as they are used in your source data and in the worksheet names.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'stop changes made by this macro from re-triggering it
Application.EnableEvents = False

On Error GoTo ErrHnd

Dim intStatusCol As Integer
'set status column (A=1, U=21 etc.)
intStatusCol = 21

'test if changed cell is in status column
If Target.Column = intStatusCol Then
    'a status change has occurred
    Dim rngCell As Range
    Dim rngStart As Range
    Dim rngEnd As Range
    Dim intNoffst As Integer
    Dim intPoffst As Integer
    Dim intAoffst As Integer
    Dim intCPoffst As Integer
    Dim intPRoffst As Integer
    Dim intREoffst As Integer
    
    'clear existing data
    Worksheets("Archived").Cells.Clear
    Worksheets("Pending").Cells.Clear
    Worksheets("Normal").Cells.Clear
    Worksheets("PRE REG").Cells.Clear
    Worksheets("CRB Pending").Cells.Clear
    Worksheets("Reject").Cells.Clear
    
    'set source data start row (in column A)
    Set rngStart = Worksheets("Source").Range("A2")
    'find end of source data (in column A)
    Set rngEnd = Worksheets("Source"). _
        Range("A" & CStr(Application.Rows.Count)).End(xlUp)
        
    'set three destination row offsets
    intNoffst = 0
    intPoffst = 0
    intAoffst = 0
    intCPoffst = 0
    intPRoffst = 0
    intREoffst = 0
    'loop through source
    'offset is one less than required column
    For Each rngCell In Worksheets("Source").Range(rngStart, rngEnd)
        Select Case rngCell.Offset(0, intStatusCol - 1).Text
            'copy entire row to appropriate sheet
            Case "Archived"
                rngCell.Resize(1, 25).Copy _
                    Destination:=Worksheets("Archived").Range("A2"). _
                    Offset(intAoffst, 0)
                    intAoffst = intAoffst + 1
            Case "Pending"
                    rngCell.Resize(1, 25).Copy _
                    Destination:=Worksheets("Pending").Range("A2"). _
                    Offset(intPoffst, 0)
                    intPoffst = intPoffst + 1
            Case "Normal"
                    rngCell.Resize(1, 25).Copy _
                    Destination:=Worksheets("Normal").Range("A2"). _
                    Offset(intNoffst, 0)
                    intNoffst = intNoffst + 1
            Case "CRB Pending"
                    rngCell.Resize(1, 25).Copy _
                    Destination:=Worksheets("CRB Pending").Range("A2"). _
                    Offset(intCPoffst, 0)
                    intCPoffst = intCPoffst + 1
            Case "PRE REG"
                    rngCell.Resize(1, 25).Copy _
                    Destination:=Worksheets("PRE REG").Range("A2"). _
                    Offset(intPRoffst, 0)
                    intPRoffst = intPRoffst + 1
            Case "Reject"
                    rngCell.Resize(1, 25).Copy _
                    Destination:=Worksheets("Reject").Range("A2"). _
                    Offset(intREoffst, 0)
                    intREoffst = intREoffst + 1
            Case Else
            'clear any partially copied data
            Worksheets("Archived").Cells.Clear
            Worksheets("Pending").Cells.Clear
            Worksheets("Normal").Cells.Clear
            Worksheets("PRE REG").Cells.Clear
            Worksheets("CRB Pending").Cells.Clear
            Worksheets("Reject").Cells.Clear
            'turn on screen updating
            Application.ScreenUpdating = True
            'reenable events
            Application.EnableEvents = True
            'display warning message
            MsgBox "Row " & rngCell.Row & " does not have a valid status" & _
                vbCrLf & _
                "It has this: " & rngCell.Offset(0, intStatusCol - 1).Text & _
                vbCrLf & "The program will now quit - correct data and try again"
            'quit sub
            Exit Sub
        End Select
    Next rngCell
End If
'reenable events
Application.EnableEvents = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
'turn on screen updating
Application.ScreenUpdating = True
'reenable events
Application.EnableEvents = True
MsgBox "Warning: there was an error when running the macro" _
    & vbCrLf & "Check the data"
End Sub

One thing you might like to add is a quick way to add or change statuses:
Make a list of the statuses, say cells Z1 to Z6
Select Cell U2 (the first with a status in it)
From the menu select Data - Validation...
In the 'Settings' Tab, from the 'Allow:' drop-down, select 'List'
In the box labeled 'Source:' select the 6 cells Z1 to Z6
If you use the worksheet icon button to do the selection it will look like this:
$Z$1:$Z$6
The $ signs keep the address from being changed when we copy this validation to other cells.
Click OK
Test the Validation by clicking on cell U2 - you will get a drop-down list containing the valid status words.
Now with U2, right-click and Copy.
Select all the cells in column U that are, or maybe used for records, right-click and select 'Paste Special...'
In the Paste Special dialog box select 'Validation' and OK.
All cells in column U will now have the drop-down list. No one will be able to enter "Pedning" or whatever !

Also put this formula in cell AA1 (next to the first status word in the list:
=COUNTIF($U$2:$U$30,Z1)
and in cell AB1 enter this:
=IF(COUNTIF(INDIRECT("'"&Z1&"'!"&"U$2:$U$30"),Source!Z1)=AA1,"OK","Error")
Select the two cells and drag them down alongside the list.
Now column AA will show the number of records for each category
and column AB will have 'OK' if the number of records on the individual sheets match the numbers in the Source sheet. If they don't match - you get 'Error'

I also added a warning message to the macro, so that if there is an internal error when the macro runs, you get a warning about it.

Regards


Report •

#7
January 25, 2011 at 08:57:06
I am trying to do the same type of thing Humar, but when I take your macros code and put in in with the appropriate changes nothing happens.

what I am working with is a workbook with two worksheets, names Tony and Manny, that automatically copy into a Master List which is the first sheet. I have the VBA all set for this. The one i want to create is one that takes the status from the Tony and Manny sheets, which is column D, and auto copies and seperates into three more sheets, HOLD, DEAD, and LOST. There are more statuses, such as Funding and Contract Out, but I am only interested in seperating the three aforementioned, and taking them off of the original sheet.

Can you help me with this?


Report •


Ask Question