VBA to copy and paste data based on lookup criteria to select and position data

[BvDA]

Hi,

Outline of required code relating to the attachment. I managed small sections of the code but not the lookup and position based on criteria.

For each cell in Col F

<On Chk log test tab>
Check if Col F is blank.
If yes go to Col C and copy date.
Check site number and

On Tracker Test tab
Match to site number in Col A on Tracker test tab.
Find next empty cell on matched row
Paste the date copied

On Chk log test tab
Place "logged" in Col F.

Else if Col F = "logged"
Then move to next cell.

[Tinbendr]

You didn't give any complete examples in your book, so I hope this is what you wanted.

Sub MatchData()

Dim WS As Worksheet
Dim WSTrk As Worksheet
Dim A As Long
Dim LastRow As Long
Dim LC As Long
Dim C As Range

Set WS = Worksheets("Chk log test")
Set WSTrk = Worksheets("Tracker test")

With WSTrk
    LR = .Cells(.Rows.Count, "A").End(xlUp).Row
End With


With WS
    'Last row on Chk Log Test
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    
    For A = 2 To LastRow
        If .Cells(A, "F") = "" Then
            With WSTrk.Range("A1:A" & LR)
                Set C = .Find(WS.Cells(A, "A"), , xlValues)
                If Not C Is Nothing Then
                    'Find next column on Tracker
                    LC = LastNonZero(C.Row)
                    'Test to make sure the functino returned a number > 2 & < Max column
                    If LC > 2 Then
                        'post date
                        WSTrk.Cells(C.Row, LC) = WS.Cells(A, "C")
                        WS.Cells(A, "F") = "LOGGED"
                    End If
                End If
            End With
        End If
    Next
        
End With


End Sub

Function LastNonZero(aRow As Long) As Long

Dim J As Long

J = 3

Do Until Worksheets("Tracker test").Cells(aRow, J).Value = ""
    If J < Worksheets("Tracker test").Columns.Count Then
        J = J + 1
    Else
        LastNonZero = 0
        Exit Function
    End If
Loop

LastNonZero = J

End Function