I'm stuck trying to modify my code

[Big Lar]

Sheet(“Next”) Cells (A1:A) are populated in an earlier routine
Sheet(“Members”) is a database that has been updated in another routine

Prior to saving the updated project, I wish to add the updated values that exist in Sheet(Members) Column R to all corresponding entries in Sheet(Next) Column B

So:
If Sheet(Next) A1 = "Jones John"

Sheet(Next) B1 = Sheet(Members) “Jones John” iRow 16 value.
Etc…

I have similar code already in my project and thought I knew how to modify it.
But, I’ve been wrestling with this for hours and can’t figure out my error or even if it’s the best solution.​

Const msMembersSheet As String = "Members"
Const msNextSheet As String = "Next"
 
Dim iCol As Integer
Dim lRow As Long, lRow1 As Long
Dim objNames As Object
Dim rCur As Range
Dim sKey As String
Dim wsMembers As Worksheet, wsNext As Worksheet
 
Set objNames = Nothing
Set objNames = CreateObject("Scripting.Dictionary")
Set wsNext = Sheets(msNextSheet)
Set wsMembers = Sheets(msMembersSheet)
 
For Each rCur In Intersect(wsMembers.UsedRange, wsMembers.Columns("C"))
 
    lRow = rCur.Row
    If lRow > 1 Then
        sKey = Trim$(CStr(rCur.Value))
        If sKey <> "" Then
            On Error Resume Next
            objNames.Add Key:=sKey, Item:=lRow
            On Error GoTo 0
        End If
    End If
Next rCur
 
iCol = wsNext.Cells(1, Columns.Count).End(xlToLeft).column - 22
 
 
For Each rCur In Intersect(wsNext.UsedRange, wsNext.Columns("A"))
    lRow = rCur.Row
 
    If lRow > 2 Then
        sKey = Trim$(CStr(rCur.Value))
        If sKey <> "" Then
            lRow1 = 1
            On Error Resume Next
            lRow1 = objNames.Item(sKey)
            On Error GoTo 0
            If lRow1 = 0 Then
                lRow1 = wsNext.Cells(Rows.Count, "A").End(xlUp).Row ' + 1
                wsNext.Range("A" & lRow1).Value = sKey
                'objNames.Add Key:=sKey, Item:=lRow1
            End If
            wsNext.Cells(lRow1, iCol).Value = wsMembers.Range("R" & lRow).Value
          
        End If
    End If
Next rCur
 
objNames.RemoveAll
Set objNames = Nothing

 

[sergioMabres]

Hi Lar your code does not do what you think it does
It does not start from row 1 starts at row 2 the first loop and in 3 the second loop
It does not use column B as stated in "Sheet(Next) B1 = Sheet(Members) “Jones John” iRow 16 value." it uses column C
And it does not match by name, the code is pretty coll thus uses a dictionary but it lacks of GetKey(CreateObject
Cheers
Sergio

 

[Fluff]

Does this do what you need?

Sub Big_Lar()
   Dim Cl As Range
   Dim sKey As String
   Dim wsMembers As Worksheet, wsNext As Worksheet
    
   Set wsNext = Sheets("Next")
   Set wsMembers = Sheets("pcode")
   
   With CreateObject("scripting.dictionary")
      For Each Cl In wsMembers.Range("C2", wsMembers.Range("C" & Rows.Count).End(xlUp))
         sKey = Trim(Cl.Value)
         If sKey <> "" Then
            .Add sKey, Cl.Offset(, 15).Value
         End If
      Next Cl
   
      For Each Cl In wsNext.Range("A3", wsNext.Range("A" & Rows.Count).End(xlUp))
         sKey = Trim(Cl.Value)
         Cl.Offset(, 1).Value = .Item(sKey)
      Next Cl
   End With
End Sub

 

[Big Lar]

Fluff,
Brilliant! Many, many thanks!
You've again saved me from hours of brain damage.
I'm heavily indebted to you.
Big Lar

 

[Fluff]

You're welcome & thanks for the feedback