VBA to Copy Paste a cell based on Row & Column

[PeepDeep]

Hi,

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

 

[PeepDeep]

So update, it appears the srcRow is simply equal to nothing, which is not ideal:

 Set srcRow = .Range("A2", .Cells(2, lastCol))

If anyone has any wisdom on why this is the case it would be welcome!

 

[Tupe77]

I changed a couple of points and I think it works now, but does this work the way you wanted?

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 Date ' changed string to date (I could not find date by string definition, but this depends on the cell data type. If it's not working change this back to 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.Column) = .Cells(i, "D") ' changed found1 to found1.Column (found1 give found1.value not address and you need cells(row,column)
                    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

 

[PeepDeep]

Hi,

Thanks for responding. I also asked for help on StackOverflow and a user gave me this code to find the column:

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

Then subbing in "Col" instead of "Found1" means it works a treat.

 

[Joe4]

I also asked for help on StackOverflow and a user gave me this code to find the column:

This is known as "Cross-posting". Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Please post the link to where you have posted it on StackOverflow. If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.