Solved: Copy Cell and Comment

[randolphoral]

I am needing the code to Loop through B2:B300 and do a VLookup for the cell value and VLookup for comment on the Sheet titled Test.

There are two things I am trying to accomplish...

1. Instead of using ActiveCell.Offset(0, 1) to describe Column C editing to have "C" in the code since each week the Column will change and currently would result in having to count the offset and it would be easier to just change the code to the appropriate Column letter.

2. The code below will not move to the next cell in Column B as it just stays at B2 as it loops.

Any help would be greatly appreciated.

Sub COPY()
Dim Name As Range, NRg As Range, r As Range, ws As Worksheet, cmnt As String, f As Long
Set Name = Range(Range("B2"), Range("B2").End(xlDown))
Set ws = Worksheets("Test")
Set r = ws.Range("F2", ws.Range("F65536").End(xlUp))
f = WorksheetFunction.VLookup(ActiveCell, ws.Range("F2:L5"), 7, 0)
cmnt = WorksheetFunction.VLookup(ActiveCell, ws.Range("F2:L5"), 6, 0)
ActiveCell.Offset(0, 1) = f
On Error Resume Next
For Each NRg In Name
With NRg
ActiveCell.Offset(0, 1) = f
If cmnt = "" Then
        ActiveCell.Offset(0, 1).ClearComments
Else
        With ActiveCell.Offset(0, 1)
            .ClearComments
            .AddComment
            .Comment.Visible = False
            .Comment.Text Text:=cmnt
            ActiveCell.Offset(0, 1) = f
        End With
    End If
 
End With
Next NRg
End Sub

[mbarron]

Your loop is constantly offsetting from ActiveCell, not a new cell as it does the looping. Try changing the ActiveCell.Offset's with in the For Next loop to NRg.offset

[randolphoral]

I updated the code to reflect NRg. offset and that worked great. Thank you!

[randolphoral]

Here is how I changed the code to get it to work

Sub COPY_TIME_and_OT_COMMENTS()
Dim Name As Range, NRg As Range, r As Range, ws As Worksheet, cmnt As String, f As Double
Set Name = Range(Range("B3"), Range("B3").End(xlDown))
Set ws = Worksheets("Test")
Set r = ws.Range("F2", ws.Range("F65536").End(xlUp))
Application.ScreenUpdating = False
On Error Resume Next
For Each NRg In Name
With NRg
f = WorksheetFunction.VLookup(NRg.Offset, ws.Range("F2:L1000"), 7, 0)
cmnt = WorksheetFunction.VLookup(NRg.Offset, ws.Range("F2:L1000"), 6, 0)
If cmnt = "" Then
        NRg.Offset(0, 84).ClearComments
        NRg.Offset(0, 84) = f
Else
        With NRg.Offset(0, 84)
            .ClearComments
            .AddComment
            .Comment.Visible = False
            .Comment.Text Text:=cmnt
            NRg.Offset(0, 84) = f
        End With
    End If
End With
Next NRg
End Sub

[mbarron]

Because of your error handler [vba]On Error Resume Next
[/vba] when the VLOOUP does not match, you do not see the error that would result and f does not get changed for the previous value. You can add the line f=0 (or whatever value you want to appear in the cell immediately after the [vba]With NRg[/vba] to set f to something other than the previous value.

I see you've edited the last post, did you figure out the problem with the f?