View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Copy Comments problem

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:

彜o 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 廝 of work order numbers and populate the corresponding
column 廛 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 havent 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