Hi,
Below code works fine except for the format in comment boxes.
Each cell in rng, row 4, is a number formatted with single decimal place (eg. 2,7).
Each cell in rng, row 5, is a number formatted with no decimal place (eg. 1).
Each cell in rng, row 6, is a number formatted with percentage format(eg. 67%).
All cells in rng, row 4-6, have formulas.
Now Comment Box show: 2,66666666666667 - 1 - 0,666666666666667
I want Comment Box to show: 2,7 - 1 - 67%
Someone know how to do that?
Sub CommRank()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim Arr As Variant
Dim rng As Range
Dim cell As Range
Dim i
Dim Name As Variant
Dim DEF As Variant
Dim ABC As Variant
Dim target As Range
Set wb1 = Workbooks("WorkbookName")
Set wb2 = ActiveWorkbook
Set ws1 = wb1.Sheets("Sheet1")
Set ws2 = wb2.Sheets("Sheet1")
Application.ScreenUpdating = False
ws2.Range("B1").Activate
Set rng = ws1.Range("B1:AT6") 'Range to find values for Comments
With rng
Arr = rng
For Each cell In ws2.Range("AC13:AC20") 'Range for Comments
Name = ActiveCell
DEF = ActiveCell.Offset(1, 1)
ABC = ActiveCell.Offset(, 1)
For i = LBound(Arr, 2) To UBound(Arr, 2)
If Arr(1, i) = Name And Arr(2, i) = DEF And Arr(3, i) = ABC Then
Set target = cell
target.ClearComments
target.AddComment
With target.Comment
.Text Arr(4, i) & " - " & Arr(5, i) & " - " & Arr(6, i)
.Shape.Shadow.Visible = msoFalse
.Visible = False
.Shape.TextFrame.AutoSize = True
End With
Exit For
End If
Next i
ActiveCell.Offset(, 2).Select
Next cell
ws2.Range("A1").Select
Application.ScreenUpdating = True
End With
End Sub
Any help will be much appreciated.
Thanks in advance!
Bookmarks