VBA: Moving a row based on list item

[Chris_010101]

Hello,

I have a workbook with two sheets: 'Live or Hold' and 'Archive'.

The 'live or hold' sheet has a column with a data validation list, containing the list items: 'Open', 'Hold', 'Archive'

When 'Archive' is selected in the drop-down list, I would like it to automatically move (or cut and paste) the whole row to the 'Archive' tab, so that we have a record of all the archived data. Preferably, this should happen when 'Archive' is selected from the list; I'd rather not assign the macro to a button as this workbook will be used by multiple people.

I'm not an advanced VBA user but I can do some basic stuff.

Any help appreciated

Regards
Chris

 

[LazyBug]

Hello!

Try this on a copy of your file. Paste code to sheet 'Liver or Hold' module:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fromRow%, archiveRow%, archiveList As Worksheet
    If Target.Cells.Count > 1 Then Exit Sub
    
    If Not Application.Intersect(Target, Range("N2:N10")) Is Nothing Then 'amend this range address to your
        Set archiveList = ThisWorkbook.Worksheets("Archive")
            If Target.Value = "Archive" Then
                fromRow = ActiveCell.Row
                archiveRow = archiveList.Cells(archiveList.Rows.Count, 1).End(3).Row + 1
                Range(Cells(fromRow, 1), Cells(fromRow, 13)).Copy archiveList.Cells(archiveRow, 1)
                Rows(fromRow).EntireRow.Delete
            End If
    End If
End Sub

 

[Chris_010101]

Hello!

Try this on a copy of your file. Paste code to sheet 'Liver or Hold' module:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fromRow%, archiveRow%, archiveList As Worksheet
    If Target.Cells.Count > 1 Then Exit Sub
   
    If Not Application.Intersect(Target, Range("N2:N10")) Is Nothing Then 'amend this range address to your
        Set archiveList = ThisWorkbook.Worksheets("Archive")
            If Target.Value = "Archive" Then
                fromRow = ActiveCell.Row
                archiveRow = archiveList.Cells(archiveList.Rows.Count, 1).End(3).Row + 1
                Range(Cells(fromRow, 1), Cells(fromRow, 13)).Copy archiveList.Cells(archiveRow, 1)
                Rows(fromRow).EntireRow.Delete
            End If
    End If
End Sub

Yes, it works well. Thanks very much for that!!

 

[LazyBug]

Yes, it works well. Thanks very much for that!!

Thanks for the feedback. Glad to help you.

 

[Chris_010101]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fromRow%, archiveRow%, archiveList As Worksheet
If Target.Cells.Count > 1 Then Exit Sub

If Not Application.Intersect(Target, Range("L2:L500000")) Is Nothing Then 'amend this range address to your
Set archiveList = ThisWorkbook.Worksheets("USED - RAs")
If Target.Value = "OFFERED" Then
fromRow = ActiveCell.Row
archiveRow = archiveList.Cells(archiveList.Rows.Count, 1).End(3).Row + 1
Range(Cells(fromRow, 1), Cells(fromRow, 13)).Copy archiveList.Cells(archiveRow, 1)
Rows(fromRow).EntireRow.Delete
End If
End If
End Sub

Hi,

Wondering if you can kindly help me again.

I've tried to port this across to another spreadsheet but it moves and deletes the row below.

Thanks
Chris

 

[Chris_010101]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fromRow%, archiveRow%, archiveList As Worksheet
If Target.Cells.Count > 1 Then Exit Sub

If Not Application.Intersect(Target, Range("L2:L500000")) Is Nothing Then 'amend this range address to your
Set archiveList = ThisWorkbook.Worksheets("USED - RAs")
If Target.Value = "OFFERED" Then
fromRow = ActiveCell.Row
archiveRow = archiveList.Cells(archiveList.Rows.Count, 1).End(3).Row + 1
Range(Cells(fromRow, 1), Cells(fromRow, 13)).Copy archiveList.Cells(archiveRow, 1)
Rows(fromRow).EntireRow.Delete
End If
End If
End Sub

Hi,

Wondering if you can kindly help me again.

I've tried to port this across to another spreadsheet but it moves and deletes the row below.

Thanks
Chris

I've fixed it.

I found out it's because I wasn't using a list, I was typing instead whilst I was testing the sheet. It now works

Thanks again.