comment copy

[Seeker]

I have two sheets in the same workbook, sht 1 and sht 2.
Sht 1 (with comments in each cell of Col D)
Col D Col F
1,000 aa
500 bb
30 rr
800 aa
Sht 2 Col A to R in row 1 as heading
Col A Col B Col C… Col R
aa bb cc rr
If sht 1 Col F match heading in sht 2, append amount together with comment
to the same column in sht 2
Result
Col A Col B Col C… Col R
aa bb cc rr
1,000 500 30
800
I have following code done to append amount but cannot paste with comment
together, also it is too long as I need to set 17 “if†(from col a to col r).
Any suggestion?
Sheets("sht 1").Select
Lastrow = Range("F" & Rows.Count).End(xlUp).Offset(0, 0).Row
Range("F" & Lastrow).Select
If Range("F"&Lastrow) = "aa" Then
Lastrow = Range("D" & Rows.Count).End(xlUp).Offset(0, 0).Row
Range("D" & Lastrow).Select
Selection.Copy
Sheets("sht 2").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.Paste ‘I also tried ActiveSheet.Paste ,
Selection.PasteSpecial but all cannot copy with comment
Else
Sheets("sht 1").Select

 

[Jacob Skaria]

Try this UDF (User Defined function). From workbook launch VBE using Alt+F11.
From menu Insert a Module and paste the below function.

Function VLOOKUP_COMMENT(strLookupValue As String, _
rngLookUpArray As Range, lookcol As Integer, retCol As Integer)
Dim lngRow As Long, rngTemp As Range
For lngRow = 1 To rngLookUpArray.Rows.Count
If CStr(rngLookUpArray(lngRow, lookcol)) = strLookupValue Then _
VLOOKUP_COMMENT = rngLookUpArray(lngRow, retCol): Exit For
Next

Set rngTemp = Application.Caller
If Not rngTemp.Comment Is Nothing Then rngTemp.Comment.Delete
If Not rngLookUpArray(lngRow, retCol).Comment Is Nothing Then
rngTemp.AddComment rngLookUpArray(lngRow, retCol).Comment.Text
End If
End Function


Close and get back to workbook and try the below formula. In Sheet2 with
data as below; try this formula in Sheet2 A2 and copy to cells to the right.
Col A Col B Col C… Col R
aa bb cc rr

=vlookup_comment(A1,Sheet1!$D$1:$F$10,3,1)

If this post helps click Yes

 

[Seeker]

Hi Jacob,
This workbook will be shared with other users, is the UDF also function if
other users open this workbook? Secondly, new data will append to sheet 1,
thus, is that mean I need to copy the =vlookup_comment to row 2 to row 65536
from col A to col R? Would that make the book size too big?
Rgds

 

[Jacob Skaria]

Try the below macro....instead

Sub Macro()
Dim lngRow As Long, lngCol As Long
Dim lngLRow As Long, lngLCol As Long
Dim ws As Worksheet, rngTemp As Range

Set ws = Sheets("Sheet1")
Set rngTemp = ws.Range("F1:F" & ws.Cells(Rows.Count, "F").End(xlUp).Row)
lngLastCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Rows(2).ClearContents
For lngCol = 1 To lngLastCol
If WorksheetFunction.CountIf(rngTemp, Cells(1, lngCol)) > 0 Then
lngRow = WorksheetFunction.Match(Cells(1, lngCol), rngTemp, 0)
Cells(2, lngCol) = ws.Range("D" & lngRow)
If Not Cells(2, lngCol).Comment Is Nothing Then _
Cells(2, lngCol).Comment.Delete
If Not ws.Range("D" & lngRow).Comment Is Nothing Then _
Cells(2, lngCol).AddComment (ws.Range("D" & lngRow).Comment.Text)
End If
Next
End Sub

If this post helps click Yes