Once again, Thank you sooooo much!
You make it so easy. I would be working on this problem for days. You've
saved me a lot of effort. Thanks.

"Dave Peterson" wrote:

The DestRng is the cell that gets comment. If there's an existing comment, then
the .addcomment will fail.

Since you're only using two ranges, I just created another range. Any more
ranges and I think I'd start creating some arrays so I could loop through them.
It would make the code a little easier to update since there'd be less
"copy/pasting".

Untested, but compiled.

Option Explicit
Sub Copy_Comment()

Dim SourceRng1 As Range
Dim SourceRng2 As Range
Dim SourceRngToUse As Range

Dim RngToFix As Range
Dim WkOr As Range
Dim DestRng As Range
Dim res As Variant
Dim mySourceWkbkName As String

mySourceWkbkName = "H:\FAC\Drafting Work Queue2.xls"

Set SourceRng1 = Nothing
Set SourceRng2 = Nothing
On Error Resume Next
Set SourceRng1 = Workbooks.Open(Filename:=mySourceWkbkName, _
ReadOnly:=True) _
.Worksheets("Work Orders").Range("A3:A200")
Set SourceRng2 = SourceRng1.Parent.Parent _
.Worksheets("Completed").Range("A3:A200")
On Error GoTo 0

If SourceRng1 Is Nothing _
Or SourceRng2 Is Nothing Then
MsgBox "Something wrong with source ranges!"
Exit Sub
End If

With ThisWorkbook.Worksheets("sheet1")
Set RngToFix = .Range("b4", .Cells(.Rows.Count, "B").End(xlUp))
End With

For Each WkOr In RngToFix.Cells
Set DestRng = WkOr.Offset(0, 2) '2 columns to the right

Set SourceRngToUse = SourceRng1
res = Application.Match(WkOr.Value, SourceRngToUse, 0)
If IsError(res) Then
'look in other range
Set SourceRngToUse = SourceRng2
res = Application.Match(WkOr.Value, SourceRngToUse, 0)
End If

If DestRng.Comment Is Nothing Then
'do nothing
Else
'clear existing comment???
DestRng.Comment.Delete
End If

If IsError(res) Then
'no match, do nothing
Else
If SourceRngToUse(res).Comment Is Nothing Then
'nothing to copy
Else
DestRng.AddComment Text:=SourceRngToUse(res).Comment.Text
End If
End If
Next WkOr

'close the sending workbook
SourceRngToUse.Parent.Parent.Close savechanges:=False

End Sub


Jay wrote:

That worked beautifully! Once again, thank you so much.

Actually I did notice the €œmistake€� in the original code and removed that IF
statement. I actually do not intend on €œmoving€Â� the comments, so I don€„¢t see
a need to delete the comments in the DestRng. Since the routine closes the
workbook without saving it seemed mute anyway (unless there is some other
reason for deleting the comment that I don€„¢t understand).

May I importune your help for one more thing in this macro?
The work order can be found in one of either two worksheets from my source
workbook, sheet €œWork Orders€� or sheet €œCompleted€�.

There is a perfect place in the IF statement to search the second worksheet
if there is no match found in the first worksheet, but how do I define the
second worksheet in the code?

"Dave Peterson" wrote:

First, there were a couple of mistakes in that original code--I cleared the
comments in wkor--not destrng. But since you're dumping that code, it doesn't
matter <bg.

Anyway, I'd just create a macro to run on demand. It would open up the
"sending" workbook and do all the cells in B4 to the last used cell in column B.

This is untested, but it did compile--and the destrng stuff is fixed:

Option Explicit
Sub Copy_Comment()

Dim SourceRng As Range
Dim RngToFix As Range
Dim WkOr As Range
Dim DestRng As Range
Dim res As Variant
Dim mySourceWkbkName As String

mySourceWkbkName = "H:\FAC\Drafting Work Queue2.xls"

Set SourceRng = Nothing
On Error Resume Next
Set SourceRng = Workbooks.Open(Filename:=mySourceWkbkName, ReadOnly:=True) _
.Worksheets("Work Orders").Range("A3:A200")
On Error GoTo 0

If SourceRng Is Nothing Then
MsgBox "Something wrong with source range!"
Exit Sub
End If

With ThisWorkbook.Worksheets("sheet1")
Set RngToFix = .Range("b4", .Cells(.Rows.Count, "B").End(xlUp))
End With

For Each WkOr In RngToFix.Cells
Set DestRng = WkOr.Offset(0, 2) '2 columns to the right

res = Application.Match(WkOr.Value, SourceRng, 0)

If DestRng.Comment Is Nothing Then
'do nothing
Else
'clear existing comment???
DestRng.Comment.Delete
End If

If IsError(res) Then
'no match, do nothing
Else
If SourceRng(res).Comment Is Nothing Then
'nothing to copy
Else
DestRng.AddComment Text:=SourceRng(res).Comment.Text
End If
End If
Next WkOr

'close the sending workbook
SourceRng.Parent.Parent.Close savechanges:=False

End Sub



Jay wrote:

Dave, You are a godsend!
Thank you for the clear layout of the code, complete with easy to follow
comments. That answers my question precisely.
However, your clarification question identifies my next dilemma:

€ŀœSo you have a single workorder number€¦ you want to copy a comment from€ÂÂ�

Actually, I have a list of work order numbers. How is the best way to
proceed down column €ŀœB€ÂÂ� of work order numbers and populate the corresponding
column €ŀœD€ÂÂ� with comments?
I was thinking of making this routine into a user defined function that
could be copied down a column in Excel (but I haven€„¢t figured out how to
create user defined functions yet).
OR €€œ is there a simpler or better way to do this within the code itself?

"Dave Peterson" wrote:

So you have a single workorder number and you want to copy a comment from the
workorder queue that is associated with that workorder number?

Option Explicit
Sub Copy_Comment()

Dim SourceRng As Range
Dim WkOr As Range
Dim DestRng As Range
Dim res As Variant
Dim mySourceWkbkName As String

mySourceWkbkName = "H:\FAC\Drafting Work Queue2.xls"

Set SourceRng = Nothing
On Error Resume Next
Set SourceRng = Workbooks.Open(Filename:=mySourceWkbkName, ReadOnly:=True) _
.Worksheets("Work Orders").Range("A3:A200")
On Error GoTo 0

If SourceRng Is Nothing Then
MsgBox "Something wrong with source range!"
Exit Sub
End If

Set WkOr = ThisWorkbook.Sheets("Sheet1").Range("B4")
Set DestRng = WkOr.Offset(0, 2) '2 columns to the right

res = Application.Match(WkOr.Value, SourceRng, 0)

If WkOr.Comment Is Nothing Then
'do nothing
Else
'clear existing comment???
WkOr.Comment.Delete
End If

If IsError(res) Then
'no match, do nothing
Else
If SourceRng(res).Comment Is Nothing Then
'nothing to copy
Else
DestRng.AddComment Text:=SourceRng(res).Comment.Text
End If
End If

'close the sending workbook
SourceRng.Parent.Parent.Close savechanges:=False

End Sub


Jay wrote:

I€„¢m working on creating a report that will insert comments from a separate
workbook. I€„¢m clear on what I want to achieve, but I€„¢m sort of clueless on
how to get there. My destination worksheet will provide a Work Order number
that is the same in the source worksheet. The comments in the source
worksheet are in the same cell as the Work Order number itself.
Any help would be greatly appreciated.

Here€„¢s what I€„¢ve got so far (but it€„¢s not working):

Sub Copy_Comment()

Dim SourcWbk As Workbook
Dim SourcRng1 As Range
Dim SourcCmt1 As Range
Dim WkOr As Range
Dim DestRng As Range
Dim cmt As Comment

Set SourcWbk = Workbooks.Open("H:\FAC\Drafting Work Queue2.xls")
On Error Resume Next
Set SourcRng1 = SourcWbk.Sheets("Work Orders").Range("A3:A200")
Set WkOr = ThisWorkbook.Sheets("Sheet1").Range("B4")
Set DestRng = ThisWorkbook.Sheets("Sheet1").Range("D4")
Set SourcCmt1 = WorksheetFunction.Offset(SrcRng1,_
(WorksheetFunction.Match(WkOr, SrcRng1, 0) - 1), 0, 1, 1)
Set cmt = SourcCmt1.Comment


DestRng.Value = cmt.Text

End Sub

--

Dave Peterson


--

Dave Peterson


--

Dave Peterson