Copy/Paste Data Log Based on a Condition

Question

The following code copies a row of data from a Dashboard to a Data_Log as you repeatedly click the Start button. I am trying to add a condition that each time a Yes appears in column D of the Time Log copy the data from the Dashboard to the Data_Log and only click the Start button once to initiate as it should run continuously until you hit the Stop button.

The problem is I cannot copy the data when the Yes condition appears on the Time_Log.

Logic -> Condition of Yes appears on the Time_Log -> copy from Dashboard -> paste to Data_Log -> continues to copy/paste as the Yes increments on the Time_Log with time moving forward. Thank you for your help.

Option Explicit

Dim LoggingActive As Boolean
Public Sub StartLoggingData()
    Application.StatusBar = "Logging Dashboard Started"
    LoggingActive = True
    CopyData
End Sub
Public Sub StopLoggingData()
    Application.StatusBar = "Logging Dashboard Stopped"
    LoggingActive = False
End Sub
 
Private Sub CopyData()
 
    Dim sht1 As Worksheet, sht2 As Worksheet, sht3 As Worksheet, cpyRng As Range, logRng As Long, rngLogTargetBeginningCell As Range, rngLastCellSelection As Range, r As Long, lastRow As Range
 
    If LoggingActive = True Then

        Set sht1 = ThisWorkbook.Sheets("Dashboard")
        Set sht2 = ThisWorkbook.Sheets("Data_Log")
        Set sht3 = ThisWorkbook.Sheets("Time_Log")
        Set cpyRng = sht1.Range("A39:Q39")
        Set rngLogTargetBeginningCell = sht2.Rows(sht2.Rows.Count).Columns(1).End(xlUp).Offset(1, 0)
        Set rngLastCellSelection = Selection ' remember the last selection because pasting will change the active cell
 
        Application.ScreenUpdating = False ' Stop Updating Graphic during data copy
        lastRow = sht3.Cells(Rows.Count).End(xlUp).Row
        For r = 4 To lastRow
            If sht3.Range("D" & r).Value = "Yes" Then
                cpyRng.Copy
                rngLogTargetBeginningCell.Offset(0, 1).PasteSpecial xlPasteValues
                rngLastCellSelection.Select    ' reselect the old cell
            End If
        Next r
    End If
    Application.CutCopyMode = False ' Remove the copy area marker
    Application.ScreenUpdating = True  ' update graphics again
End Sub

Answer 1

lastRow is typed as a Range instead of a Numeric data type. wsTime_Log.Cells(Rows.Count) refers to column 1 which is empty.

lastRow As Range
lastRow = wsTime_Log.Cells(Rows.Count).End(xlUp).Row

rngLogTargetBeginningCell should be determined inside the loop.

Corrections

lastRow As Long
lastRow = wsTime_Log.Cells(Rows.Count, "D").End(xlUp).Row

Refactored Code

Dim LoggingActive As Boolean

Public Sub StartLoggingData()
    Application.StatusBar = "Logging Dashboard Started"
    LoggingActive = True
    CopyData
End Sub

Public Sub StopLoggingData()
    Application.StatusBar = "Logging Dashboard Stopped"
    LoggingActive = False
End Sub
 
Private Sub CopyData()
    LoggingActive = True
    
    Dim r As Long, lastRow As Long
    Dim ValidationRange As Range
    Set ValidationRange = TimeLogValidationRange
    
    If LoggingActive = True Then

        Application.ScreenUpdating = False ' Stop Updating Graphic during data copy
    
        For r = 1 To ValidationRange.Rows.Count
            If ValidationRange.Cells(r, 1).Value = "Yes" Then
                With DashboardDataRange
                    NewData_LogRow.Resize(.Rows.Count, .Columns.Count).Value = .Value
                End With
            End If
        Next r
    End If
    
    Application.ScreenUpdating = True  ' update graphics again
End Sub

Function TimeLogValidationRange() As Range
    With wsTime_Log
        Set TimeLogValidationRange = .Range("A1", .UsedRange).Columns("D")
        With TimeLogValidationRange
            Set TimeLogValidationRange = TimeLogValidationRange.Offset(3).Resize(.Rows.Count - 3)
        End With
    End With
End Function

Function DashboardDataRange() As Range
    Set DashboardDataRange = wsDashboard.Range("A39:Q39")
End Function

Function NewData_LogRow() As Range
    With wsData_Log
        Set NewData_LogRow = .UsedRange.Columns(1)
        Set NewData_LogRow = NewData_LogRow.Offset(NewData_LogRow.Rows.Count).Resize(1).EntireRow
    End With
End Function

Function wsDashboard() As Worksheet
    Set wsDashboard = ThisWorkbook.Sheets("Dashboard")
End Function

Function wsData_Log() As Worksheet
    Set wsData_Log = ThisWorkbook.Sheets("Data_Log")
End Function

Function wsTime_Log() As Worksheet
    Set wsTime_Log = ThisWorkbook.Sheets("Time_Log")
End Function

I like to create helper functions for all my ranges. This allows me to test exactly what is being referenced like this:

Application.Goto TimeLogValidationRange
Application.Goto DashboardDataRange
Application.Goto NewData_LogRow