Articles

Copy Row Based On User Input

March 19, 2010 at 06:47:57
Specs: Windows XP

Hi,
I have been on this site multiple times and it has helped me alot. I usually find answers on what i'm looking for but i'm puzzled with this one excel sheet i'm working on, if anyone can help.
I have an excel sheet that has alot of tracking information for work, i have a Status column that says "Pending" "Completed" and "Filed", and i have 3 other sheets that say Pending, Completed, and FIled, i would like to have it so that if someone enters information and selects one of the status that the whole row be copied to its respective sheet. I hope i have explained it well enough.

Thank you


See More: Copy Row Based On User Input

Report •


#1
March 19, 2010 at 08:09:16

Hi,

Assuming that the status Pending/Completed/Filed is entered in column D then
Try this:

In the source worksheet where data is added, right-click the worksheet name tab and select 'View code'
Enter this code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDest As Range

On Error GoTo ErrHnd:

'stop any further changes triggering this code
Application.EnableEvents = False

'test if change was in the status column (4=D)
If Target.Column = 4 Then
    'find next empty row on destination worksheet
    Set rngDest = Worksheets(Target.Text). _
                Range("A" & CStr(Application.Rows.Count)).End(xlUp).Offset(1, 0)
    'copy source row to destination
    Target.EntireRow.Copy
    rngDest.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If

'remove copy marquee
Application.CutCopyMode = False

'restore events
Application.EnableEvents = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
'restore events
Application.EnableEvents = True
End Sub

You can change the column used for the status in this line:

'test if change was in the status column (4=D)
If Target.Column = 4 Then

I suggest that you use data validation in the status column to ensure that only the correct text is entered which exactly matches the worksheet names.

If you entries have a unique ID, you could extend the code to delete the entry from the other worksheets.
At the moment if you have an item labeled "Pending" it will be in the Pending worksheet, but change it's status to "Completed" and it will now be in both worksheets - Pending and Completed.

Regards


Report •

#2
March 19, 2010 at 08:27:07

Thank you very much but I'm sorry i got lost. Let me explain further how my sheets are set up

I have these tabs: Current Transfers : Pending : Completed

and in each sheet i have these columns:
Date Rec'd | Account # | In/Out | Rep # | Customer Name | Receiving Firm/Delivering Firm Fee | Reason Notes | Processor | Status.
our tracking processor enters info in the current transfer tab, right now we have over 5000 entries. I want it so that everything in the current tab that has "pending" in the status column which is O to be copied to pending, and same thing for completed. I don't know if that makes any sense. I tried copying the macro you gave me in the pending tab and changing 4=d to 15=o but it didn't do anything. Please let me know if i'm doing something wrong.

Thank you

On a side note... i was able to put that code you gave me in the source sheet, but now i was wondering if there was a way so that if that it was changed from pending to completed it can be deleted from pending and added to completed. I know i am asking for too much but any help would be appreciated.


Report •

#3
March 19, 2010 at 12:46:11

Hi

When you changed the row number to O (15) did you change this:

If Target.Column = 4 Then

The macro must be in the 'Current Transfers' worksheet for it to work - i.e., the worksheet where you select Pending or Completed.

If the Pending/ Completed/ Filed cells are not changed by a user entering the data, but are pre-filled by the transaction processor, then the macro will have to be changed.

At present the macro is designed to run automatically when a cell in column D (or O) is changed by a user entering Pending etc.

Also does the transaction processor add/append to the source worksheet every day, or does it over-write the data.

Finally if you want items deleted from the Pending worksheet when you transfer them to Completed, is there a unique ID (and which column is it in), that can be used to find the item in 'Pending', so it can be deleted.

Regards


Report •

Related Solutions

#4
March 19, 2010 at 12:56:14

Thank you very much, i got it to work very well. They add to the source everyday as they go along. now i just need to figure out a way to delete it from pending when moved to completed or filed and vice versa. Each transaction has a unique account number and customer name, i am not sure if that helps.

Thank you once again


Report •

#5
March 19, 2010 at 13:30:37

Hi,

If you give me the columns containing the account number and name I should be able to suggest some code to remove the entries from pending when they are placed in Completed.

Regards


Report •

#6
March 19, 2010 at 13:34:45

The column with account number is called "Account#" and the names are under "Customer Name"

Report •

#7
March 20, 2010 at 09:22:07

Hi,

The macro now includes steps to remove an item from Pending when it is placed in Completed and to remove an item from Completed when it is moved to Filed.

As you did not give the column letters for the account name and number, you will need to change them here:

    'set offsets for columns for name and account#
    'note column A is offset = 0, B=1 etc.
    intNameOffset = 0
    intAcctOffset = 1

Here is the extended macro:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim intTcol As Integer

On Error GoTo ErrHnd:

'stop any further changes triggering this code
Application.EnableEvents = False

'set Target column - column with Pending/Completed/Filed entry
intTcol = 4

'test if change was in the status column
If Target.Column = intTcol Then
    Dim rngDest As Range
    Dim wsSearch As Worksheet
    Dim rngStart As Range
    Dim rngEnd As Range
    Dim rngCell As Range
    Dim intNameOffset As Integer
    Dim intAcctOffset As Integer
    
    'set offsets for columns for name and account#
    'note column A is offset = 0, B=1 etc.
    intNameOffset = 0
    intAcctOffset = 1
    
    'find next empty row on destination worksheet
    Set rngDest = Worksheets(Target.Text). _
                Range("A" & CStr(Application.Rows.Count)).End(xlUp).Offset(1, 0)
    
    'copy source row to destination
    Target.EntireRow.Copy
    rngDest.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    
    'if moved to Filed, remove from Completed
    If Target.Text = "Filed" Then
        'create a worksheet object
        Set wsSearch = Worksheets("Completed")
        'set start range for search
        Set rngStart = wsSearch.Range("A2")
        'set end range for search
        Set rngEnd = wsSearch.Range("A" & CStr(Application.Rows.Count)).End(xlUp)
        'loop through cells in range to find match
        For Each rngCell In wsSearch.Range(rngStart, rngEnd)
            If Target.Offset(0, intNameOffset - intTcol + 1).Text = _
                                    rngCell.Offset(0, intNameOffset).Text And _
               Target.Offset(0, intAcctOffset - intTcol + 1).Text = _
                                    rngCell.Offset(0, intAcctOffset).Text Then
               'delete row
                rngCell.EntireRow.Delete
            End If
        Next rngCell
    End If
    
    'if moved to Completed, remove from Pending
    If Target.Text = "Completed" Then
        'create a worksheet object
        Set wsSearch = Worksheets("Pending")
        'set start range for search
        Set rngStart = wsSearch.Range("A2")
        'set end range for search
        Set rngEnd = wsSearch.Range("A" & CStr(Application.Rows.Count)).End(xlUp)
        'loop through cells in range to find match
        For Each rngCell In wsSearch.Range(rngStart, rngEnd)
            If Target.Offset(0, intNameOffset - intTcol + 1).Text = _
                                rngCell.Offset(0, intNameOffset).Text And _
               Target.Offset(0, intAcctOffset - intTcol + 1).Text = _
                                rngCell.Offset(0, intAcctOffset).Text Then
               'delete row
                rngCell.EntireRow.Delete
            End If
        Next rngCell
    End If
    
End If

'remove copy marquee
Application.CutCopyMode = False

'restore events
Application.EnableEvents = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
'restore events
Application.EnableEvents = True
End Sub

Note that as this macro erases data, ensure that you always make a backup before running the macro.

Test the macro on test data to ensure that it performs 'as expected'

Regards


Report •


Ask Question