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

[Roadknight87]

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

 

[Roadknight87]

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

 

[vcoolio]

You're welcome Adam and thanks for the feed back.

Cheerio,
vcoolio.

 

[Roadknight87]

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

 

[Roadknight87]

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

 

[vcoolio]

Hello Adam,

A slight change to the code in the 'ThisWorkbook" module should do the task for you:-

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.

 

[Roadknight87]

Legend! thanks mate

 

[vcoolio]

You're welcome Adam. Glad to have been able to assist again.

Cheerio,
vcoolio.

 

[Roadknight87]

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

 

[vcoolio]

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:-

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.

 

[Roadknight87]

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"??