PDA

View Full Version : Copy values and paste it into a insert comment



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

Bob Phillips
02-28-2008, 12:39 PM
Sub Test1()
Dim mpCell As Range, mpRow As Range, rngCheck As Range
Dim mpTemp As String, mpLongest1 As Long, mpLongest2 As Long
Dim mpHead As String
Dim i As Long
Dim varData

With Worksheets("Range")

Set rngCheck = .Range(.Range("A1:C1"), .Range("A1").End(xlDown))
For Each mpRow In rngCheck.Rows

If mpLongest1 < Len(mpRow.Cells(1, 1).Text) Then mpLongest1 = Len(mpRow.Cells(1, 1).Text)
If mpLongest2 < Len(mpRow.Cells(1, 2).Text) Then mpLongest2 = Len(mpRow.Cells(1, 2).Text)
Next mpRow
End With
varData = rngCheck

For i = 1 To UBound(varData, 1)

mpTemp = mpTemp & vbLf & _
Trim(varData(i, 1)) & _
Space(mpLongest1 - Len(varData(i, 1)) + 1) & Trim(varData(i, 2)) & _
Space(mpLongest2 - Len(varData(i, 2)) + 1) & varData(i, 3)
Next i

With Worksheets("Expected Results").Range("A2")

On Error Resume Next
.Comment.Delete
On Error GoTo 0
mpHead = "Part" & Space(mpLongest1 - 3) & "Machine" & Space(mpLongest2 - 6) & "Qty"
.AddComment mpHead & mpTemp

With .Comment.Shape.TextFrame

.Characters(1, Len(mpHead & mpTemp)).Font.Name = "Courier New"
.Characters(1, Len(mpHead)).Font.Bold = True
.HorizontalAlignment = xlHAlignDistributed
.VerticalAlignment = xlVAlignJustify
.AutoSize = True
End With
End With

End Sub

Shazam
02-29-2008, 07:04 AM
Perfect xld it works just perfect.

Bob Phillips
02-29-2008, 07:06 AM
Unfortunately it has to be that nasty Courier font to get it to line up.