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
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