Need Unique Only in MsgBox

[JMay]

I'm creating code that will inform me
of what rows in my range B1:F20
have been highlighted in yellow.

Extract...
Range("B1").Select
For i = 1 To NumRows
For j = 1 To NumCols
If Rng.Cells(i, j).Interior.ColorIndex = 6 Then
Tag = True
If Tag = True Then XRow = XRow & "," & CStr(i)
End If
Next j
Next i
MsgBox "Rows " & XRow & " are yellow"
End Sub

Currently my msgbox is displaying:
Rows ,3,7,9,9,9,14,18 are yellow.

It is correct - Row 9 has 3 cells
highlighted - whereas 3,7,14,& 18
have only a single cell HLed.

What can I apply to get
the msgbox to show
Rows 3,7,9,14,18 are yellow
Elimination of the leading "," would be
a bonus,

TIA,

 

[Don Guillett]

Look here for another way
http://tinyurl.com/8pp3g

to get rid of the leading comma try
xrow=right(xrow,len(xrow)-1)

 

[David McRitchie]

Hi Jim,
It would help if you indented your code, you placed the
If Tag = True Then XRow = XRow & "," & CStr(i)
belongs outside the inner loop.

Thanks for including some code to start with.
I limited the selection to the usedrange, even though formatting
has nothing to do with used range, but I'm used to making
selections of columns like B:F and you would certainly NOT
want to examine every cell in such a range. Adapt to your needs.

The corrected code

Sub test2005_1210()
Dim i As Long, j As Long, rng As Range
Dim numCols As Long, numRows As Long, xRow As String, tag As Boolean
Range("B1:F20").Select
Set rng = Intersect(Selection, ActiveSheet.UsedRange)
numRows = rng.Rows.Count
numCols = rng.Columns.Count
tag = False
For i = 1 To numRows
For j = 1 To numCols
If rng.Cells(i, j).Interior.ColorIndex = 6 Then tag = True
Next j
If tag = True Then xRow = xRow & "," & CStr(i)
tag = False
Next i
If Len(xRow) = 0 Then
MsgBox "No yellow cells"
Else
MsgBox "Rows " & Mid(xRow, 2) & " contain Yellow cells"
End If
End Sub