Shazam
02-28-2008, 11:01 AM
Hi Everyone,
I have posted this question before and got my answer but I would like to modify the code just a bit. I've been working on this better part of the morning and I still can't get it to work. I would like to copy columns A thru C and paste it into the insert comment. I left a sample workbook below to show you in a visual sense what I'm trying to do.
Here is what I'm using...
Sub Test1()
Dim mpCell As Range, rngCheck As Range
Dim mpTemp As String, lngcelllen As Long, lngindex As Long
Dim varData
With Worksheets("Range")
Set rngCheck = .Range(.Range("A1:C1"), .Range("A1").End(xlDown))
For Each mpCell In rngCheck
If lngcelllen < Len(mpCell.Text) Then lngcelllen = Len(mpCell.Text)
Next mpCell
End With
varData = rngCheck
For lngindex = 1 To UBound(varData, 1)
mpTemp = mpTemp & vbLf & varData(lngindex, 1) & Space(lngcelllen - 2 - Len(varData(lngindex, 1))) & varData(lngindex, 2)
Next lngindex
With Worksheets("Expected Results").Range("A2")
On Error Resume Next
.Comment.Delete
On Error GoTo 0
.AddComment "Part " & Space(lngcelllen - 2) & "Machine" & mpTemp
With .Comment.Shape.TextFrame
.Characters(1, 4).Font.Bold = True
.Characters(lngcelllen + 3, 19).Font.Bold = True
.HorizontalAlignment = xlHAlignDistributed
.VerticalAlignment = xlVAlignJustify
.AutoSize = True
End With
End With
End Sub
Here is a link where I first posted the queation.
http://www.vbaexpress.com/forum/showthread.php?t=14272
I have posted this question before and got my answer but I would like to modify the code just a bit. I've been working on this better part of the morning and I still can't get it to work. I would like to copy columns A thru C and paste it into the insert comment. I left a sample workbook below to show you in a visual sense what I'm trying to do.
Here is what I'm using...
Sub Test1()
Dim mpCell As Range, rngCheck As Range
Dim mpTemp As String, lngcelllen As Long, lngindex As Long
Dim varData
With Worksheets("Range")
Set rngCheck = .Range(.Range("A1:C1"), .Range("A1").End(xlDown))
For Each mpCell In rngCheck
If lngcelllen < Len(mpCell.Text) Then lngcelllen = Len(mpCell.Text)
Next mpCell
End With
varData = rngCheck
For lngindex = 1 To UBound(varData, 1)
mpTemp = mpTemp & vbLf & varData(lngindex, 1) & Space(lngcelllen - 2 - Len(varData(lngindex, 1))) & varData(lngindex, 2)
Next lngindex
With Worksheets("Expected Results").Range("A2")
On Error Resume Next
.Comment.Delete
On Error GoTo 0
.AddComment "Part " & Space(lngcelllen - 2) & "Machine" & mpTemp
With .Comment.Shape.TextFrame
.Characters(1, 4).Font.Bold = True
.Characters(lngcelllen + 3, 19).Font.Bold = True
.HorizontalAlignment = xlHAlignDistributed
.VerticalAlignment = xlVAlignJustify
.AutoSize = True
End With
End With
End Sub
Here is a link where I first posted the queation.
http://www.vbaexpress.com/forum/showthread.php?t=14272