Worksheet_Change or Worksheet_Calculate

reberryjr

Well-known Member
Joined
Mar 16, 2017
Messages
714
Office Version
  1. 365
Platform
  1. Windows
Looking for some guidance here. I have a workbook that has a dynamic amount of sheets. As of now, I have 4 static sheets and 2 test sheets that are part of the dynamic volume. Each of the test sheets (I'll refer to them as Client sheets going forward), has 44 columns. I'd like to implement some code that runs across all of the dynamic sheets, and when the value of the last row in column AR changes to either "Paid" or "Late" (via a formula), the current row is copied and pasted to the row below it.

I'm relatively new to VBA and have pieced this code together from things I've seen in this, and other forums. I realize that the below code is only changing the value of one cell, but I figured I would start out small and if the code worked, I would expand on it. One thing that seems particularly odd is, when I hit F5 to run the code, I keep getting prompted to save the macro, which hasn't ever happened with any of the other code that I've written.

Code:
Private Sub WorkSheetCalculate()

Dim ws As Worksheet
Dim LastRow As Long
Dim NextRow As Long


LastRow = ws.Range("D" & Rows.Count).End(xlUp).Row
NextRow = ws.Range("D" & Rows.Count).End(xlUp).Row + 1


For Each ws In Worksheets
If Not ws.Name = "Bios" And Not ws.Name = "Stats" And Not ws.Name = "Financials" And Not ws.Name = "Variables" Then
    If Target = ws.Range("AR" & LastRow) Then
        If InStr(1, Range("AR" & LastRow), "Paid") Then
            Range("A" & NextRow) = "=Today()"
        ElseIf InStr(1, Range("AR" & LastRow), "Late") Then
            Range("A" & NextRow) = "=Today()"
        Else
            Range("A" & NextRow) = ""
        End If
    End If
End If


Next ws


End Sub
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Is there any reason why you are using column D as the LastRow and not column AR since you say
last row in column AR changes
Also, do you want to copy the entire last row where AR is either "Paid" or "Late" or just place the date in column A?
You should be aware that a Worksheet_Change event will not be triggered by the result of a formula so the Worksheet_Calculate event is the one to use.
 
Upvote 0
I'm using the data in column D on all sheets, as it's the client I'd, which is unique. Outside of a few differences, yes, I would want to copy the entire row. There are 5 cells where 8 don't want to copy the data, so I figured it's easier to copy the row, then empty the contents of those 5 cells.
 
Upvote 0
Is the last row with data in column D the same as the last row with data in column AR? What are the 5 cells that you don't want included/
 
Upvote 0
The last row would have data in columns D and AR. I wouldn't want columns H, O, V, AC or AJ copied.
 
Upvote 0
Try:
Code:
Private Sub WorkSheetCalculate()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim LastRow As Long
    For Each ws In Worksheets
        If Not ws.Name = "Bios" And Not ws.Name = "Stats" And Not ws.Name = "Financials" And Not ws.Name = "Variables" Then
            LastRow = ws.Range("AR" & ws.Rows.Count).End(xlUp).Row
            Select Case ws.Range("AR" & LastRow).Value
                Case "Paid", "Late"
                    ws.Range("A" & LastRow & ":G" & LastRow).Copy ws.Range("A" & LastRow + 1)
                    ws.Range("I" & LastRow & ":N" & LastRow).Copy ws.Range("I" & LastRow + 1)
                    ws.Range("P" & LastRow & ":U" & LastRow).Copy ws.Range("U" & LastRow + 1)
                    ws.Range("W" & LastRow & ":AB" & LastRow).Copy ws.Range("W" & LastRow + 1)
                    ws.Range("AD" & LastRow & ":AI" & LastRow).Copy ws.Range("AD" & LastRow + 1)
                    ws.Range("AK" & LastRow & ":AR" & LastRow).Copy ws.Range("AK" & LastRow + 1)
            End Select
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thank you! It works quite well! It doesn't appear that I was too far off.
 
Upvote 0
Ok, I'm not sure what happened, but now the code isn't working. I did add a few columns to the sheet, but I believe they're all accounted for in the manipulated code below.

Code:
Private Sub WorkSheetCalculate()

Application.ScreenUpdating = False
    
Dim ws As Worksheet
Dim LastRow As Long
    
For Each ws In Worksheets
    If Not ws.Name = "Bios" And Not ws.Name = "Stats" And Not ws.Name = "Financials" And Not ws.Name = "Variables" Then
    LastRow = ws.Range("AW" & ws.Rows.Count).End(xlUp).Row
        Select Case ws.Range("AW" & LastRow).Value
            Case "Paid", "Late"
                ws.Range("A" & LastRow + 1) = "=Today()"
                ws.Range("B" & LastRow + 1) = "=Now()"
                ws.Range("C" & LastRow + 1) = "Update"
                ws.Range("D" & LastRow & ":G" & LastRow).Copy ws.Range("D" & LastRow + 1)
                ws.Range("I" & LastRow & ":N" & LastRow).Copy ws.Range("I" & LastRow + 1)
                ws.Range("P" & LastRow & ":U" & LastRow).Copy ws.Range("P" & LastRow + 1)
                ws.Range("W" & LastRow & ":AB" & LastRow).Copy ws.Range("W" & LastRow + 1)
                ws.Range("AD" & LastRow & ":AI" & LastRow).Copy ws.Range("AD" & LastRow + 1)
                ws.Range("AK" & LastRow & ":AO" & LastRow).Copy ws.Range("AK" & LastRow + 1)
                ws.Range("AU" & LastRow & ":AW" & LastRow).Copy ws.Range("AU" & LastRow + 1)
        End Select
    End If
Next ws
Application.ScreenUpdating = True
End Sub
 
Upvote 0
How is it not working? Do you get an error message? Is some of the data being copied? Please clarify. I did notice that you changed "AR" to "AW". Is it now the last row in column AW that contains "Paid" or "Late" instead of column AR?
 
Upvote 0

Forum statistics

Threads
1,223,970
Messages
6,175,693
Members
452,667
Latest member
vanessavalentino83

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top