(Excel) Cut Rows and paste at last row on next sheet

[Firestart]

Hi,

I need to Cut rows from one sheet and paste onto another. A column in my sheet has a dropdown menu (which represents a status) and each status is the same name some other sheets. I would like to be able to change the dropdown selection, have code to respond depending on the selection and cut the row and paste on the sheet that the selection points to.

Is that too much for VB?

Help appreciated. Thanks

[DKenny]

A column in my sheet has a dropdown menu (which represents a status)

Is this a combobox control, or is it an in-cell dropdown list?

I need to Cut rows from one sheet and paste onto another.

Do you need to cut multiple rows that all have the same status?
Are the rows always the same set of row numbers?

[mikeyc1204]

Is the dropdown a combobox or are the cells data validated?

[mikeyc1204]

doh! too slow

[Firestart]

Is this a combobox control, or is it an in-cell dropdown list?
In-Cell dropdown

Do you need to cut multiple rows that all have the same status?
Just 1 row at a time is fine

[DKenny]

Here's an event proc for the _change event of the worksheet that should get you started.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDropDown As Range
Dim sToSheet As String
Dim lRowNumber As Long
Dim lToRow As Long
 
    'Set a reference to the cell with
    'the drop down
    Set rngDropDown = Range("A1")
    
    'Is the cell with the dd being changed?
    'And is it not being cleared
    If Target.Address = rngDropDown.Address _
    And Target.Value <> "" Then
        
        'Get the name of the sheet that we need to copy to
        sToSheet = rngDropDown.Value
        
        'Get the first unused row on the target sheet
        lToRow = Worksheets(sToSheet).UsedRange.Row + Worksheets(sToSheet).UsedRange.Rows.Count
        
        'Get the number of the row that we need to copy
            'I don't know your criteri for selection
            'so I'm just setting it to an arbitrary value
        lRowNumber = 5
        
        'Copy the row to the new sheet
        Me.Rows(lRowNumber).Copy Destination:=Worksheets(sToSheet).Rows(lToRow)
    End If
End Sub

[Firestart]

Hi,

Thanks.

I forgot to add that there are some Staus names in the dropdown list that apply to one sheet and the status names are not the same as the sheet names.

For example

Dropdwn selctions WaitingUG, Waiting IA, and Waiting PB belong on 'Waiting' Sheet

Withdraws, No Funding etc belong on 'Closed' sheet

Also, how do I get this to run?

and also, not sure how this part works

'Get the number of the row that we need to copy
'I don't know your criteri for selection
'so I'm just setting it to an arbitrary value
lRowNumber = 5

I guess any status in the range in question e.g. a1:a200 whose name is equal to sheet one, or two.

Thanks again.

[DKenny]

I forgot to add that there are some Staus names in the dropdown list that apply to one sheet and the status names are not the same as the sheet names.

For example
Dropdwn selctions WaitingUG, Waiting IA, and Waiting PB belong on 'Waiting' Sheet
Withdraws, No Funding etc belong on 'Closed' sheet

The easiest way to achieve this is use a SELECT CASE statement based on the value of the DD to select the sheet name.

In the code I provided above, you would do this by replacing

'Get the name of the sheet that we need to copy to
        sToSheet = rngDropDown.Value

with

'Get the name of the sheet that we need to copy to
        Select Case rngDropDown.Value
            Case "WaitingUG": sToSheet = "Waiting"
            Case "Waiting IA": sToSheet = "Waiting"
            Case "Waiting PB": sToSheet = "Waiting"
            Case "Withdraws": sToSheet = "Closed"
            Case "No Funding": sToSheet = "Closed"
            'Case etc, etc
        End Select

[DKenny]

Also, how do I get this to run?

This is an event macro associated with the worksheet that contains the dropdown. You will need to copy this code in the the worksheet module for that sheet. Then this code will run automatically whenever that worksheet is changed.

[DKenny]

not sure how this part works

'Get the number of the row that we need to copy
'I don't know your criteri for selection
'so I'm just setting it to an arbitrary value
lRowNumber = 5

In a previous post, you mentioned that you only need to copy one line, in my example code I am copying line 5 from the worksheet.
I don't know how you are going to decide which line on the worksheet needs to be copied.

I guess any status in the range in question e.g. a1:a200 whose name is equal to sheet one, or two.

I have no idea what you mean here

[Firestart]

Hi,

been busy so have not been able to try this out, but I made some slight adjustments to the code. Still doesnt work. Any Ideas?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDropDown As Range
Dim sToSheet As String
Dim lRowNumber As Long
Dim lToRow As Long
 
    'Set a reference to the cell with
    'the drop down
    Set rngDropDown = Range("M1:M1000")
    
    'Is the cell with the dd being changed?
    'And is it not being cleared
    If Target.Address = rngDropDown.Address _
    And Target.Value <> "" Then
               
        'Get the name of the sheet that we need to copy to
         'sToSheet = rngDropDown.Value
        Select Case rngDropDown.Value
            Case "WaitingUGReview": sToSheet = "WaitingUGReview"
            Case "Waiting IA": sToSheet = "Waiting"
            Case "Waiting PB": sToSheet = "Waiting"
            Case "Withdraws": sToSheet = "Closed"
            Case "No Funding": sToSheet = "Closed"
            'Case etc, etc
        End Select
                
        'Get the first unused row on the target sheet
        lToRow = Worksheets(sToSheet).UsedRange.Row + Worksheets(sToSheet).UsedRange.Rows.Count
        
        'Get the number of the row that we need to copy
            'I don't know your criteri for selection
            'so I'm just setting it to an arbitrary value
        lRowNumber = 5
        
        'Copy the row to the new sheet
        Me.Rows(lRowNumber).Copy Destination:=Worksheets(sToSheet).Rows(lToRow)
    End If
End Sub

[DKenny]

What issues are you having?

Here are some issues that I can see straight away.

Set rngDropDown = Range("M1:M1000")

I had assumed that the dropdown was in a single cell, your range has 1000 cells. Does the code need to do different actions based on each of these 1000 cells or should it perform the same action regardless of which cell is being changed?

'Get the number of the row that we need to copy
            'I don't know your criteri for selection
            'so I'm just setting it to an arbitrary value
        lRowNumber = 5

OK, I just selected row 5 to copy as an example. You still need to change this reference so that it points to the row (rows?) that you need to copy.

[Firestart]

Hi,

Thanks for your help.

The dropdown is about 100 or so lines of the same column and requires the same action regardsless of which page.

Eric

[DKenny]

OK, I need to take a step back here.
What exactly is the requirement?

What should happen when the user makes a change to one of these dropdowns?

[Firestart]

If the dropdown changes, the whole line should move to the first free line on another sheet (sheet depends on the dropdown selection)

[DKenny]

OK, next question.
What are the list of options in the DD and what are the names of the associated sheets?

[Firestart]

List of DD options: Assoc Sheets

1. Waiting Review - UG
2. Approved - Open
3. Rejected - Closed
4. Functional - Open
5. Technical - Open
6. IA - UG
7. Funding approved - Open
8. Funding rejected - Closed
9. FS - Open
10. Awaiting Sign - UG
11. Dev - Open
12. Test - Open
13. Waiting Release - Open
14. Released - Closed
W - Withdrawn - Closed
H – Hold - Hold

[DKenny]

Try the following code.
It uses the value in column M to decide which sheet to move the row to, using the SELECT CASE statement. I din't know if your DD options included the number in your post. You may need to change all the CASE statements if they are included.

Once the sheet is selected, the code then copies the row in question to that sheet and pastes it to the next unused row.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngMove As Range
Dim wksDestination As Worksheet
 
    'Only continue if the change is being made in Column "M"
    If Target.Column = 13 Then
 
        'Decide which sheet to move to
        Select Case Target.Value
            Case "Waiting Review":      Set wksDestination = ThisWorkbook.Worksheets("UG")
            Case "Approved":            Set wksDestination = ThisWorkbook.Worksheets("Open")
            Case "Rejected":            Set wksDestination = ThisWorkbook.Worksheets("Closed")
            Case "Functional":          Set wksDestination = ThisWorkbook.Worksheets("Open")
            Case "Technical":           Set wksDestination = ThisWorkbook.Worksheets("Open")
            Case "IA":                  Set wksDestination = ThisWorkbook.Worksheets("UG")
            Case "Funding approved":    Set wksDestination = ThisWorkbook.Worksheets("Open")
            Case "Funding rejected":    Set wksDestination = ThisWorkbook.Worksheets("Closed")
            Case "FS":                  Set wksDestination = ThisWorkbook.Worksheets("Open")
            Case "Awaiting Sign":       Set wksDestination = ThisWorkbook.Worksheets("UG")
            Case "Dev":                 Set wksDestination = ThisWorkbook.Worksheets("Open")
            Case "Test":                Set wksDestination = ThisWorkbook.Worksheets("Open")
            Case "Waiting Release":     Set wksDestination = ThisWorkbook.Worksheets("Open")
            Case "Released":            Set wksDestination = ThisWorkbook.Worksheets("Closed")
            Case Else:                  Exit Sub 'don't move if no value is selected
        End Select
        
        'Disable events so that we don't
        'get a recursive call
        Application.EnableEvents = False
        
        'get the range to be moved
        Set rngMove = Target.EntireRow
        
        'Copy the range to the destinantion sheet
        rngMove.Copy Destination:=wksDestination.Range("A1").End(xlDown).Offset(1, 0)
        
        'delete the original
        rngMove.Delete shift:=xlShiftUp
        
        'Re-enable events
        Application.EnableEvents = True
        
        Set rngMove = Nothing
        Set wksDestination = Nothing
    End If
End Sub

[Firestart]

Declan,

This is great, but without trying this I have a question,

Line: 'Copy the range to the destinantion sheet
rngMove.Copy Destination:=wksDestination.Range("A1").End(xlDown).Offset(1, 0)


If I already have 20 lines on the destination sheet this will just paste over one of my lines right. I guess what I am saying is I think there is an assumption that the destination is blank to begin with. I am not sure how you would search for the first available line after the 9th line on the destinationsheet.

E

[DKenny]

.End(xlDown) will get you to the last used row of the destination sheet.

.Offset(1, 0) moves one more row down, so you will be on the next available row.

[Firestart]

I have not been able to get it working. This event based macro should just kick in whenever a change is made to the worksheet. I have checked if any settings I have hinder its operation, but nothing obvious. What next?

[DKenny]

events may be disabled.
In the VBA editor show the immediate window, (Ctrl+G).
Type the following into the immediate window followed by enter.

application.EnableEvents=True

Now we need to see if the macro is firing. Set a breakpoint at this line, (select the line and press F9)

If Target.Column = 13 Then

Now try changing a value in any dropdown in column M and step throught the code.

[Firestart]

Hey,

Nothing happens!

I put in the application.EnableEvents=True and hit return,...nothing, then highlight that line and press F9 to breakpoint,....nothing happens when I change the dropdown.

If I got to run,...its not on the list (because its event based).

What next?

[DKenny]

Dumb question, but you have got this procedure in the code page for the worksheet in question right?
It should not be in a module.

[Firestart]

Doh!

It works now :-) but,....

.End(xlDown) should get me to the last used row of the destination sheet but it doesn't. Instead my line from the target page is pasted on top of the 'Freeze Panes' line.

[Firestart]

Its ok, I have sorted that out now! Thanks

[Firestart]

DKenny rocks!

But I have a small problem. If I have Auto Filter on on the destination sheet the line from the target sheet moves to the next available line,...which is right but then if you remove the filter it appears to have copied ofver a line that was not in the filter. Does that make sense?

Somehow I need to make sure that the target line is not pasted over destination cells.

Any ideas?

[Firestart]

Anyone got any ideas as to the previous post?

[DKenny]

Before you copy the line too the destination sheet, you could clear the filters.

wksDestination.ShowAllData

[Firestart]

Does it matter where you put this line? I have put it before

rngMove.Copy Destination:=wksDestination.Range("A1").End(xlDown).Offset(1, 0)

This works intermitantly. Now even thoug I have removed the line you gave, it doesn't work at all at times? How strange?

Anything to do with: application.EnableEvents=True

What do you think the problem is?

[Firestart]

Can anyone solve this problem?

[Firestart]

Here is the code to answer this problem, however, it tends to be a bit slow. Can anyone see what would be slowing down the system with this code?


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngMove As Range 'hold range
Dim wksDestination As Worksheet 'hold worksheet

'Application.EnableEvents = True
'Application.ScreenUpdating = False


'Only continue if the change is being made in Column "M"
If Target.Column = 13 Then

'Decide which sheet to move to
Select Case Target.Value
Case "1. Waiting UG Review": Set wksDestination = ThisWorkbook.Worksheets("WaitingUGReview")
Case "2. Approved by UG for Impact Analysis": Set wksDestination = ThisWorkbook.Worksheets("Open")
Case "3. Rejected by UG for Further work": Set wksDestination = ThisWorkbook.Worksheets("Closed_Withdrawn_Rejected")
Case "4. Functional Impact Assessment": Set wksDestination = ThisWorkbook.Worksheets("Open")
Case "5. Technical Impact Assessment": Set wksDestination = ThisWorkbook.Worksheets("Open")
Case "6. IA with business for Funding approval": Set wksDestination = ThisWorkbook.Worksheets("WaitingUGReview")
Case "7. Business Funding approved": Set wksDestination = ThisWorkbook.Worksheets("Open")
Case "8. Business Funding rejected": Set wksDestination = ThisWorkbook.Worksheets("Closed_Withdrawn_Rejected")
Case "9. Functional Specification": Set wksDestination = ThisWorkbook.Worksheets("Open")
Case "10. Awaiting Business Funtional Specification Signoff": Set wksDestination = ThisWorkbook.Worksheets("WaitingUGReview")
Case "11. In Development": Set wksDestination = ThisWorkbook.Worksheets("Open")
Case "12. UAT": Set wksDestination = ThisWorkbook.Worksheets("Open")
Case "13. Waiting Point Release": Set wksDestination = ThisWorkbook.Worksheets("Open")
Case "14. Released": Set wksDestination = ThisWorkbook.Worksheets("Closed_Withdrawn_Rejected")
Case "W - Withdrawn by business": Set wksDestination = ThisWorkbook.Worksheets("Closed_Withdrawn_Rejected")
Case "H - Placed on Hold": Set wksDestination = ThisWorkbook.Worksheets("On Hold")
Case Else: Exit Sub 'don't move if no value is selected
End Select

'Disable events so that we don't
'get a recursive call
Application.EnableEvents = False

'get the range to be moved
Set rngMove = Target.EntireRow

'show all data on the destination sheet to avoid overcopying
'Set wksDestination = ThisWorkbook.Worksheets("On_Hold")
'Sheets(wksDestination).Select
'Selection.AutoFilter Field:=4 ', Criteria1:="All"
'If wksDestination.AutoFilter = True Then
'Copy the range to the destinantion sheet
'rngMove.Copy Destination:=wksDestination.Range("A9:Y9").End(xlDown).Offset(1, 0)
'Else
'wksDestination.ShowAllData
'End If
'ThisWorkbook.Worksheets("Open").Activate
'Selection.AutoFilter Field:=4
'ThisWorkbook.Worksheets("On_Hold").Activate
'Selection.AutoFilter Field:=4
'ThisWorkbook.Worksheets("WaitingUGReview").Activate
'Selection.AutoFilter Field:=4
'ThisWorkbook.Worksheets("Closed_Withdrawn_Rejected").Activate
'Selection.AutoFilter Field:=4

'Worksheets("WaitingUGReview").= True
wksDestination.Activate
'Selection.AutoFilter Field:=4
wksDestination.Range("A9:Y9").AutoFilter 4, "<>"


'wksDestination.AutoFilter 4, "<>"
'wksDestination.AutoFilterMode = False


'Copy the range to the destinantion sheet
rngMove.Copy Destination:=wksDestination.Range("A9:Y9").End(xlDown).Offset(1, 0)


'delete the original
rngMove.Delete shift:=xlShiftUp

'Sort Data
Range("A9:W9").Sort Key1:=Range("A9"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Range("A9:W9").AutoFilter 4, "<>"

'Re-enable events
Application.EnableEvents = True

'Application.ScreenUpdating = True


Set rngMove = Nothing
Set wksDestination = Nothing
End If
End Sub

Sub run()
Application.EnableEvents = True
End Sub