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

 

[RoryA]

You don't need to select the sheet at all. Change this:

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

to this:

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

 

[jdun]

You don't need to select the sheet at all. Change this:

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

to this:

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

That seems to at least make the code functional! I am now getting:

"Run-time error '1004':

PasteSpecial method of Range Class failed"

When I hit debug, it highlights this code.

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

The code seems to almost work, then break on the very last line. I'll include an image of what the OUTPUT sheet looks like once the error shows up. Any idea on what the fix could be?

 

[RoryA]

I'm confused - that line is before the one that you said was causing the problem, so presumably it was working before?

 

[jdun]

I'm confused - that line is before the one that you said was causing the problem, so presumably it was working before?

Huh, I guess you're right!! I'm actually struggling to replicate my initial error now. It's still giving me the same error, even when I revert the code to the original state. Is there any ideas on how I could fix this error? I'm confused as to why the codes works perfectly up until the very last line it needs to paste. Would it help if I included pictures of both the INPUT and OUTPUT sheets before and after the code is ran?

 

[RoryA]

Do you have any other event code that might be running, such as a Worksheet_Change code?

 

[jdun]

Do you have any other event code that might be running, such as a Worksheet_Change code?

Hey! Sorry for the delay, ended up getting busy.

I dont think I've any other code running. I checked all modules and worksheets, the only code I have on this file is the one listed above. I've figured out the code works perfectly if I run it manually from a module, but when I put it in the "INPUT" object as a Worksheet_Change, that seems to break it, and give me the error listed above. Any idea on how to fix this?

 

[Skyybot]

Hey! Sorry for the delay, ended up getting busy.

I dont think I've any other code running. I checked all modules and worksheets, the only code I have on this file is the one listed above. I've figured out the code works perfectly if I run it manually from a module, but when I put it in the "INPUT" object as a Worksheet_Change, that seems to break it, and give me the error listed above. Any idea on how to fix this?

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

 

[DanteAmor]

Welcome to MrExcel.

Here another macro for you to consider.
It's another approach, filter the values, copy and paste.

Sub Project_Complete()
  Dim shI As Worksheet, shO As Worksheet
  Dim arr As Variant
  Dim n As Long
  
  Set shI = Sheets("INPUT")
  Set shO = Sheets("OUTPUT")
  arr = Array("complete", "failed", "aborted")

  Application.ScreenUpdating = False
  
  With shI.Range("A2", shI.Range("E" & Rows.Count).End(3))
    'Filter sheet with words "finished", "failed", or "aborted"
    .AutoFilter 5, arr, xlFilterValues
    n = Application.CountA(.Columns(5).SpecialCells(xlCellTypeVisible)) - 1
  End With
  
  If n > 0 Then
    'Shifts entire row down
    shO.Rows("3:" & n + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    'Copies entire row from input
    shI.Range("A3", shI.Range("E" & Rows.Count).End(3)).Copy
    shO.Range("A3").PasteSpecial xlPasteValues
    shO.Range("A3").PasteSpecial xlPasteFormats
    'Should add a date to D3 and all rows copied
    With shO.Range("D3:D" & n + 2)
      .Value = Date
      .NumberFormat = "mm/dd/yy"
    End With
    'Deletes everything
    shI.Range("B3", shI.Range("E" & Rows.Count).End(3)).ClearContents
  End If
  shI.Range("A2").AutoFilter
  
  Application.ScreenUpdating = True
End Sub

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

 

[jdun]

Welcome to MrExcel.

Here another macro for you to consider.
It's another approach, filter the values, copy and paste.

Sub Project_Complete()
  Dim shI As Worksheet, shO As Worksheet
  Dim arr As Variant
  Dim n As Long
 
  Set shI = Sheets("INPUT")
  Set shO = Sheets("OUTPUT")
  arr = Array("complete", "failed", "aborted")

  Application.ScreenUpdating = False
 
  With shI.Range("A2", shI.Range("E" & Rows.Count).End(3))
    'Filter sheet with words "finished", "failed", or "aborted"
    .AutoFilter 5, arr, xlFilterValues
    n = Application.CountA(.Columns(5).SpecialCells(xlCellTypeVisible)) - 1
  End With
 
  If n > 0 Then
    'Shifts entire row down
    shO.Rows("3:" & n + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    'Copies entire row from input
    shI.Range("A3", shI.Range("E" & Rows.Count).End(3)).Copy
    shO.Range("A3").PasteSpecial xlPasteValues
    shO.Range("A3").PasteSpecial xlPasteFormats
    'Should add a date to D3 and all rows copied
    With shO.Range("D3:D" & n + 2)
      .Value = Date
      .NumberFormat = "mm/dd/yy"
    End With
    'Deletes everything
    shI.Range("B3", shI.Range("E" & Rows.Count).End(3)).ClearContents
  End If
  shI.Range("A2").AutoFilter
 
  Application.ScreenUpdating = True
End Sub

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

Thank you for this. It seems to be mostly what I'm looking for, unfortunately the macro ends up deleting the "NAME" column of the "INPUT" sheet. I need my macro to be able to keep the names in place, while deleting everything else.

When executed, the macro gives me the "Run-time error '28': Out of stack space". The macro ends up pasting the same few rows indefinitely, until it reaches row 1844.