PDA

View Full Version : Solved: Copy Cell and Comment



randolphoral
01-06-2010, 09:19 AM
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
01-06-2010, 10:03 AM
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
01-06-2010, 10:30 AM
I updated the code to reflect NRg. offset and that worked great. Thank you!

randolphoral
01-06-2010, 11:38 AM
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
01-06-2010, 12:04 PM
Because of your error handler On Error Resume Next
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 With NRg 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?