Need to move entire row based on cell drop down box value

Roadknight87

New Member
Joined
Jul 14, 2021
Messages
14
Office Version
  1. 365
Platform
  1. Windows
Hi I am very new to this so apologies, I am trying to move an entire Row from one sheet to another based on a choice from a drop down box. I have values from "A" to "M" and my drop down box is in "H" I had a code that was working for me but when I tried to add more it stopped working and then when I tried to start again it stopped working. "IMS 2021" is the main sheet and I want the information to stay here but also move to the relevant sheet based on the choice in "H". I also want to have a script in each of the other spreadsheets that when "H" is changed to completed it moves it to the "completed" sheet and deletes it from where it came from.

Private Sub Worksheet_Change(ByVal Target As Range)

' Check to see only one cell updated
If Target.CountLarge > 1 Then Exit Sub

' Check to see if entry is made in column H after row 1 and is set to "Active"
If Target.Column = 8 And Target.Row > 1 And Target.Value = "Active" Then
Application.EnableEvents = False
' Copy columns A to M to complete sheet in next available row
Range(Cells(Target.Row, "A"), Cells(Target.Row, "M")).Copy Sheets("Active Ideas").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

Application.EnableEvents = True
End If

End Sub


Move to "completed" Sheet

Private Sub Worksheet_Change(ByVal Target As Range)

' Check to see only one cell updated
If Target.CountLarge > 1 Then Exit Sub

' Check to see if entry is made in column H after row 1 and is set to "Completed"
If Target.Column = 8 And Target.Row > 1 And Target.Value = "Completed" Then
Application.EnableEvents = False
' Copy columns A to M to complete sheet in next available row
Range(Cells(Target.Row, "A"), Cells(Target.Row, "M")).Copy Sheets("Completed").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
' Delete current row after copied
Rows(Target.Row).Delete
Application.EnableEvents = True
End If

End Sub
 

Attachments

  • Code for Spreadsheet.jpg
    Code for Spreadsheet.jpg
    253.7 KB · Views: 125
Yeah I thought so, This is fine as the document is now in a shared drive on our network.

Thanks again for your help I was getting pretty frustrated with it.

Kind Regards

Adam
 
Upvote 0

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
You're welcome Adam and thanks for the feed back.

Cheerio,
vcoolio.
 
Upvote 0
Hi vcoolio,

I am wanting to tweek that code you gave me and add it to the other sheets so that f the status column gets changed it moves it from that sheet and deletes the row, like what the completed code does. So for an example if I change the status to active it will transfer there (leaving the information in IMS 2021) but then in the "Active" Sheet if I change the status to "No Go" I want it to delete it from the "Active" sheet and transfer the rows to the "No Go" sheet and I wanted it to work with all the selection in the drop down box.

Thanks for your help in advanced!

Kind Regards

Roadknight87
 
Upvote 0
I tried to tweek it myself but it came up with an error

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Columns("H")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = vbNullString Then Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False

x = Target.Row
Range(Cells(x, "A"), Cells(x, "M")).Copy Sheets(Target.Value).Range("A" & Rows.Count).End(3)(2)
Sh.Range(Cells(x, "A"), Cells(x, "M")).EntireRow.Delete

End If
Sheets(Target.Value).Columns.AutoFit

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
 
Upvote 0
Hello Adam,

A slight change to the code in the 'ThisWorkbook" module should do the task for you:-
VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
        
        If Intersect(Target, Sh.Columns("H")) Is Nothing Then Exit Sub
        If Target.Count > 1 Then Exit Sub
        If Target.Value = vbNullString Then Exit Sub
        If Sh.Name = "IMS 2021" Then Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False
        
        x = Target.Row
                If Sh.Name <> "IMS 2021" Then
                        Sh.Range(Cells(x, "A"), Sh.Cells(x, "M")).Copy Sheets(Target.Value).Range("A" & Rows.Count).End(3)(2)
                        Sh.Range(Cells(x, "A"), Sh.Cells(x, "M")).EntireRow.Delete
                End If

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Cheerio,
vcoolio.
 
Upvote 0
You're welcome Adam. Glad to have been able to assist again.

Cheerio,
vcoolio.
 
Upvote 0
Hi vcoolio,

Just wondering if I needed to modify the code to only copy rows 35-37 and columns B - M how would I change this code? D - F column is a merged cell and so is H - M. I also have moved the drop down box to column B. My sheet names I want the data to go to are AB1 (rows 35-37)

I am going to have to modify this code a little for other sheets so I was hoping you would be able to explain how I could modify rows and columns and sheets within the code?

Kind Regards

Roadknight87
 

Attachments

  • Shift report page 2.jpg
    Shift report page 2.jpg
    235.3 KB · Views: 12
  • Shift report page 4, page names.jpg
    Shift report page 4, page names.jpg
    120.8 KB · Views: 10
Upvote 0
Hello Adam,

As you're probably already aware, every coder in the Galaxy abhors merged cells as they create havoc with macros. The merged cells that you have may create some heart-ache for us but you could try this:-

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
        
        If Intersect(Target, Range("B35:B37")) Is Nothing Then Exit Sub  '---->Locks the criteria selection to three cells only.
        If Target.Count > 1 Then Exit Sub

Application.ScreenUpdating = False

        If Target.Value = "Whatever" Then '---->Place your required criteria here from the drop down.
              Range("B35:M37").Copy Sheets("AB1").[B35]
        End If

Application.ScreenUpdating = True

End Sub

Cheerio,
vcoolio.
 
Upvote 0
Hey mate, So I have finally had a chance to have a look at this and I just cant seem to get it. So if I change "whatever" to "AB1" this should transfer the information in rows 35-37 to worksheet labelled "AB1"??
 
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,714
Members
448,294
Latest member
jmjmjmjmjmjm

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top