Copy Paste a cell based on Row & Column-CodePudding

What I'd like my sheet to do is when the user has updated the values in the cells D3:D8 on the sheet "Buffy Cast" they can press the button and these values will be copied into the tab "Actual FTE". The tab "Actual FTE" has a table with multiple dates and the ID of the person. The code should find the column based on the date in the "Buffy Cast" sheet, and then the row ID, copying the data across to this location.

I admit to resurrecting some dictionary code to find the rows, which actually worked, but I'm having issues getting it to find the column. Sheets and code below, huge thank yous.

Validation Sheet

Blank Actuals Sheet

What I'd like to happen on the actuals sheet

and finally my code

    Option Explicit

Sub Update()

    Dim wsValidate As Worksheet, wsActual As Worksheet
    Dim lrValidate As Long, lrActual As Long
    Dim i As Long, r As Long, rc As Variant
    Dim n As Long, m As Long

    Dim dict As Object, key As String
    Set dict = CreateObject("Scripting.Dictionary")
    

    Set wsValidate = Worksheets("BuffyCast")
    Set wsActual = Worksheets("ActualFTE")
    
    Dim sourceWS As Worksheet, targetWS As Worksheet
    Dim lastCol As Long, lastRow As Long, srcRow As Range
    Dim found1 As Range, j As Long, Cr1 As String
 'Find column
    With wsActual
        lastCol = .Cells(2, Columns.Count).End(xlToLeft).Column
        For j = 1 To lastCol
        Cr1 = Worksheets("BuffyCast").Range("D2")
        Set srcRow = .Range("A2", .Cells(2, lastCol))
        Set found1 = srcRow.Find(What:=Cr1, LookAt:=xlWhole, MatchCase:=False)
        Next
    End With
 'Make dictionary
    With wsActual
        lrActual = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lrActual
            key = Trim(.Cells(i, "A"))
            If dict.exists(key) Then
                MsgBox "Duplicate ID No '" & key & "'", vbCritical, "Row " & i
                Exit Sub
            ElseIf Len(key) > 0 Then
                dict.Add key, i
            End If
        Next
    End With

    With wsValidate
        lrValidate = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 2 To lrValidate
            key = Trim(.Cells(i, "A"))
            If dict.exists(key) Then
                r = dict(key)
                wsActual.Cells(r, found1) = .Cells(i, "D")
                    n = n   1
            Else
                .Rows(i).Interior.Color = RGB(255, 255, 0)
                m = m   1
            End If
        Next
    End With
    MsgBox n & "Actual FTE Update" & vbLf & m & " rows not found", vbInformation
End Sub

CodePudding user response：

You can use the WorksheetFunction.Match method to find a value in a row:

Dim Col As Long
On Error Resume Next
Col = Application.WorksheetFunction.Match(wsValidate.Range("D2").Value2, wsActual.Rows(2), 0)
On Error GoTo 0

If Col = 0 Then
    MsgBox "Column was not found", vbCritical
    Exit Sub
End If

' here col has the column number you are looking for
' and you can write to that column like
wsActual.Cells(RowNumber, Col).Value = 123

This will find the value of wsValidate.Range("D2") in the second row of wsActual.