Moving rows of data automatically

[jamesplant1977]

Hi.

I was hoping you may be able to help me with a macro for the attached spreadsheet?

I want to be able to do the following:

1. Upon opening the spreadsheet, any rows that have a status of completed, will be removed and pasted to the completed tab.

2. Upon opening the spreadsheet, any rows that have yes, in the added to lessons learned log field, will be removed and pasted to the lessons learned tab.

I am quite new to excel, so would welcome your help!!!

Thanks

[JBeaucaire]

In my opinion, then best time to do these changes is when you CLOSE the workbook so the updates you've just completed cause the workbook to "move data" as the workbook is closing. When you open it next, those changes will have already be done.

Open the VB editor and paste this macro into the ThisWorkbook module:

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim LR As Long

Application.ScreenUpdating = False                  'speed up macro

With Sheets("Action Log")
    .AutoFilterMode = False                         'remove prior filters
    .Rows(1).AutoFilter                             'add new filter
    .Rows(1).AutoFilter 14, "Completed"             'filter col N for 'completed'
    LR = .Range("A" & .Rows.Count).End(xlUp).Row    'find last row of visible data
    If LR > 1 Then                                  'move data if any rows visible
        .Range("A2:O" & LR).Copy Sheets("Completed").Range("A" & Rows.Count).End(xlUp).Offset(1)
        .Range("A2:O" & LR).Delete xlShiftUp        'remove from Action Log
    End If
    .ShowAllData
    .Rows(1).AutoFilter 10, "Yes"                   'filter col J for 'yes'
    LR = .Range("A" & .Rows.Count).End(xlUp).Row    'find last row of visible data
    If LR > 1 Then                                  'move data if any rows visible
        .Range("A2:O" & LR).Copy Sheets("Lessons Learned").Range("A" & Rows.Count).End(xlUp).Offset(1)
        .Range("A2:O" & LR).Delete xlShiftUp        'remove from Action Log
    End If
    .AutoFilterMode = False                         'remove autofilter
End With
ThisWorkbook.Save                                   'Save the changes
                                                    'The workbook should now close
Application.ScreenUpdating = True
End Sub

[jamesplant1977]

Hi.

I pasted this in as requested and it didn't work, when I ran the debug, the error was the .ShowAllData

[jamesplant1977]

Please ignore my last message, it is working fine.

Thanks very much!!!

[JOHN H. DAVIS]

Maybe:

Private Sub Worksheet_Activate()
Dim rcell As Range
For Each rcell In Range("J2:J" & ActiveSheet.UsedRange.Rows.Count + 1)
    If rcell.Value = "YES" Then
        rcell.EntireRow.Copy Sheets("Lessons Learned").Range("A" & Rows.Count).End(3)(2)
        rcell.EntireRow.Delete xlUp
    End If
Next rcell
For Each rcell In Range("N2:N" & ActiveSheet.UsedRange.Rows.Count + 1)
    If rcell.Value = "Completed" Then
        rcell.EntireRow.Copy Sheets("Completed").Range("A" & Rows.Count).End(3)(2)
        rcell.EntireRow.Delete xlUp
    End If
Next rcell
       
End Sub