Using Sheets().Select in a Worksheet_Activate() macro

[jdun]

Hey all! I'm trying to write a code which copies one row from an INPUT worksheet, once a certain cell has one of three specific phrases in it. Once copied, the macro would move the entire row (columns A - D) over to a separate worksheet (named OUTPUT). The macro would then fill in the date at which this process was done in the designated cell, and then clear everything but column A of cell in the INPUT sheet.

I had my VBA working, or so I thought. It worked when it ran independently, but as soon as I tried switching it over to trigger on Worksheet_Activate, I'd get errors.

I'm wondering if it's even possible to do this, any help would be much appreciated. I'll paste my code in the post.

This is my very first attempt at VBA, this was all done in a week, by scouring forums and the microsoft help page. Thank you for any help in advance!

Sub Project_Complete()

' defines variables lr and i as long variable type
Dim i As Long

 ' forces screen to stop updating, which means it wont flicker while script runs
Application.ScreenUpdating = False

' this is checking each row of column D (column 5), moving up to row 3, sets i = the row number
    For i = Sheets("INPUT").Columns(5).Find("*", , xlValues, , xlByRows, xlPrevious).Row To 3 Step -1

     ' If any cell in row i column 5 of INPUT sheet has the word "finished", "failed", or "aborted"
        If Sheets("INPUT").Cells(i, 5).Value = "complete" Or Sheets("INPUT").Cells(i, 5).Value = "failed" Or Sheets("INPUT").Cells(i, 5).Value = "aborted" Then

            'Copies entire row from input
            Sheets("INPUT").Cells(i, 5).EntireRow.Copy

            'Shifts entire row down, copies format of row below
            Sheets("OUTPUT").Range("A3").EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow

            'Pastes row data
            Sheets("OUTPUT").Cells(3, 1).PasteSpecial xlValues

            'Pastes row format
            Sheets("OUTPUT").Cells(3, 1).PasteSpecial xlFormats

            'Should add a date to D3 cell in OUTPUT worksheet
            Sheets("OUTPUT").Select
                With Range("D3")
                    .Value = Date
                    .NumberFormat = "mm/dd/yy"
                End With

            'Deletes everything but first column of i row
            Sheets("INPUT").Cells(i, 5).Clear
            Sheets("INPUT").Cells(i, 4).Clear
            Sheets("INPUT").Cells(i, 3).Clear
            Sheets("INPUT").Cells(i, 2).Clear

            ' clears clipboard to stop marching ants
            Application.CutCopyMode = False
            
       End If

 ' moves to next row in the i loop
    Next

 ' stops screen flicker
Application.ScreenUpdating = True

End Sub

 

[jdun]

In your OP you stated that you were trying to use Worksheet_Activate but here you want to use the Worksheet_Change event?? If Worksheet_Activate then this should work.



This goes into ThisWorkbook module: (your original code with a few edits. double check it)

Sub Project_Complete()

' defines variables lr and i as long variable type
Dim i As Long
Dim ip As Worksheet, op As Worksheet

' Set Worksheet Variables
Set ip = ThisWorkbook.Sheets("INPUT")
Set op = ThisWorkbook.Sheets("OUTPUT")

 ' forces screen to stop updating, which means it wont flicker while script runs
Application.ScreenUpdating = False

' this is checking each row of column D (column 5), moving up to row 3, sets i = the row number
For i = ip.Columns(5).Find("*", , xlValues, , xlByRows, xlPrevious).Row To 3 Step -1

 ' If any cell in row i column 5 of INPUT sheet has the word "finished", "failed", or "aborted"
    If ip.Cells(i, 5).Value = "complete" Or _
        ip.Cells(i, 5).Value = "failed" Or _
            ip.Cells(i, 5).Value = "aborted" Then

        'Copies entire row from input
        ip.Cells(i, 5).EntireRow.Copy

        'Shifts entire row down, copies format of row below
        op.Range("A3").EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow

        'Pastes row data and Pastes row format
        With op.Cells(3, 1)
            .PasteSpecial xlValues
            .PasteSpecial xlFormats
        End With

        'Should add a date to D3 cell in OUTPUT worksheet
       
        With op.Range("D3")
            .Value = Date
            .NumberFormat = "mm/dd/yy"
        End With

        'Deletes everything but first column of i row
        ip.Range(Columns(2), Columns(5)).Clear
      

        ' clears clipboard to stop marching ants
        Application.CutCopyMode = False
       
   End If

' moves to next row in the i loop
Next i

 ' stops screen flicker
Application.ScreenUpdating = True
End Sub

And put this code in the "INPUT" Sheet module:

Private Sub Worksheet_Activate()
    ThisWorkbook.Project_Complete
End Sub

Yes, you're correct. I simply misspoke in that response. I want the macro to trigger on Worksheet_Activate.

Unfortunately this code is giving me a "Run-time error '28': Out of stack space". It ends up copying the first row from INPUT onto OUTPUT, but it does that on repeat. I can't double-check the code thoroughly, as this is my first try at VBA coding, or any coding really.