Sub Highlight10pctCell()
Dim DataRange As Range
Dim WhoToFind As Range
Set WhoToFind = Selection.Cells(1) 'set person you need to highlight to first cell of selection range, you need to select persion that you want to highlight and run this sub
Set DataRange = Range(Cells(1, WhoToFind.Column), Cells(Rows.Count, WhoToFind.Column).End(xlUp)) 'set highlight range to columns that has cell you selected, you can also change to whatever range you want
RandomHighlight criteria:=WhoToFind, rng:=DataRange
End Sub
Private Sub RandomHighlight(ByVal criteria As Variant, ByVal rng As Range)
Dim i As Integer, j As Integer, k As Integer, t As Integer
Dim cll As Range
Dim icoll As New Collection
i = WorksheetFunction.CountIf(rng, criteria)
If i = 0 Then Exit Sub
rng.Interior.Pattern = xlNone
For Each cll In rng
If Not IsEmpty(cll) And Not IsError(cll) Then
If UCase(Trim(cll.Value)) = UCase(Trim(criteria)) Then
icoll.Add cll
t = t + 1
If t = i Then Exit For
End If
End If
Next cll
For j = 1 To Int(i / 10) + 1
k = Int(i * Rnd + 1)
icoll(k).Interior.Color = RGB(255, 255, 0)
Next j
End Sub