Moving a Row with a negative value to another sheet

[Peterlightingdept]

Hi!

Hoping someone can give me some help here. I have a spreadsheet for tracking jobs and work hours. I have a sheet to archive projects to have a running track of all of them. I'm looking for a way to move a whole row from my working sheet to the archive sheet when the days from job reaches a negative number. So I have a column that tracks days until the job and that will run negative after the job day has passed so when that happens I want to move the whole row of information to move to the archive sheet if that makes sense. Really appreciate the help with this as I've been trying to figure it out for awhile.

Thanks!

 

[igold]

Hi Peterlightingdept,

Welcome to the MrExcel forum. This can easily be done but a little more information would help the process. Things like what column holds the number that turns negative, what sheet do you want to copy the row to (same workbook, different workbook, is it definitely called "Archive"), do you want to just copy the row or cut the row from the original sheet (what's the sheet name?), etc, etc.

The more/better info you provide now, will get you a more/better solution later.

 

[Peterlightingdept]

Hi Peterlightingdept,

Welcome to the MrExcel forum. This can easily be done but a little more information would help the process. Things like what column holds the number that turns negative, what sheet do you want to copy the row to (same workbook, different workbook, is it definitely called "Archive"), do you want to just copy the row or cut the row from the original sheet (what's the sheet name?), etc, etc.

The more/better info you provide now, will get you a more/better solution later.

Hello!

Thank you for the response. I have a sheet where I have date in columns A-O where column 'N' holds the data of remaining dates to job. Once the job occurs the days in column N go negative. Once that happens I want all the data in that row to go to a sheet I've named 'Project Archive' which is in the same workbook. My ideal is to have the row cut from the first sheet and moved to the archive either leaving the row blank or move all data up the sheet.

Thank you!

 

[igold]

Does this do what you want. The code assumes you have a header row on the "Project Archive" sheet.

Sub CutNegDates()


    Dim d As Long, lRow As Long, lRowDest As Long
    
    Application.ScreenUpdating = False
    lRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    For d = lRow To 2 Step -1
        If Not Range("N" & d) >= 0 Then
            lRowDest = Worksheets("Project Archive").Cells(Rows.Count, 1).End(xlUp).Row + 1
            ActiveSheet.Range("A" & d).EntireRow.Cut Worksheets("Project Archive").Range("A" & lRowDest)
            ActiveSheet.Range("A" & d).EntireRow.Delete shift:=xlUp
        End If
    Next
    Application.ScreenUpdating = True
    
End Sub

 

[Peterlightingdept]

Sorry I was just able to finally test this and it works great! Is there any way to make this automatically run when I open the file?

 

[igold]

Yes, but I would need the name of the worksheet that has the original data that the negatives and the rows are being deleted from.

 

[Peterlightingdept]

It's named 'Project List'

 

[igold]

Try this. This code must be put into the "ThisWorkbook" object instead of a regular module. You can just double click that on the left hand side of the VBE and paste it in. Don't forget to save the workbook before you close it. When you open the book the code will run.

Private Sub Workbook_Open()

    Dim wsPL As Worksheet: Set wsPL = Worksheets("Project List")
    Dim d As Long, lRow As Long, lRowDest As Long

    Application.ScreenUpdating = False
    lRow = wsPL.Cells(Rows.Count, 1).End(xlUp).Row
    For d = lRow To 2 Step -1
        If Not Range("N" & d) >= 0 Then
            lRowDest = Worksheets("Project Archive").Cells(Rows.Count, 1).End(xlUp).Row + 1
            wsPL.Range("A" & d).EntireRow.Cut Worksheets("Project Archive").Range("A" & lRowDest)
            wsPL.Range("A" & d).EntireRow.Delete shift:=xlUp
        End If
    Next
    Application.ScreenUpdating = True
    
End Sub

I hope this helps

 

[Peterlightingdept]

Try this. This code must be put into the "ThisWorkbook" object instead of a regular module. You can just double click that on the left hand side of the VBE and paste it in. Don't forget to save the workbook before you close it. When you open the book the code will run.

Private Sub Workbook_Open()

    Dim wsPL As Worksheet: Set wsPL = Worksheets("Project List")
    Dim d As Long, lRow As Long, lRowDest As Long

    Application.ScreenUpdating = False
    lRow = wsPL.Cells(Rows.Count, 1).End(xlUp).Row
    For d = lRow To 2 Step -1
        If Not Range("N" & d) >= 0 Then
            lRowDest = Worksheets("Project Archive").Cells(Rows.Count, 1).End(xlUp).Row + 1
            wsPL.Range("A" & d).EntireRow.Cut Worksheets("Project Archive").Range("A" & lRowDest)
            wsPL.Range("A" & d).EntireRow.Delete shift:=xlUp
        End If
    Next
    Application.ScreenUpdating = True
   
End Sub

I hope this helps

This looks like it worked! Really appreciate the help on this one. Still have a few more things I need to get this workbook perfect but this is a great step forward to making it better. Thanks again!

 

[igold]

You are welcome, I was happy to help. Thanks for the feedback.