Highlight cells based on selected cell loop.

[JF123]

Similar to this thread

http://www.mrexcel.com/forum/showthread.php?t=616627

I am looking to highlight values based on a selected cell.

However, would also like the other values in the highlighted cell's row to be used as inputs for the next search and highlight those values as well.

Can anyone help this this macro tweak? Any questions let me know.

Thank you in advance.

 

[Rick Rothstein]

Hi Rick,

With your code, some cells were not highlighted, some of those cells contain values like "10:00:00:00:98:04:cd:00" without the quotations, there are others though that were missed as well. Not sure why, as these look normal to me like "MACHINENAME_1" without the quotes, though others in that row WERE highlighted.

Looks like this might have either hit an upper limit or stopped parsing after the first occurrence of cells like "10:00:00:00:98:04:cd:00".

See if this modified version of my code works correctly for you (I think the code will still be pretty fast)...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim RowArray As Variant, RowCells As Variant
  Dim Index As Long
  Dim UR As Range, Rng As Range, Coll As New Collection
  If Target.Count > 1 Then Exit Sub
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  Set UR = ActiveSheet.UsedRange
  UR.Font.ColorIndex = xlColorIndexAutomatic
  UR.Interior.ColorIndex = xlColorIndexNone
  If Len(Target.Value) = 0 Then GoTo Whoops
  On Error Resume Next
  RowArray = Intersect(Target.EntireRow, UR).Value
  If Err.Number Then GoTo Whoops
  For Each RowCells In RowArray
    If Len(RowCells) > 0 And RowCells <> 0 Then Coll.ADD RowCells, CStr(RowCells)
  Next
  Do While Index < Coll.Count
    Index = Index + 1
    UR.Replace Coll(Index), "#N/A", xlWhole
    With UR.SpecialCells(xlConstants, xlErrors)
      .Font.Color = vbRed
      .Interior.Color = vbYellow
      For Each Rng In .Cells
        RowArray = Intersect(Rng.EntireRow, UR).Value
        For Each RowCells In RowArray
          If Len(RowCells) > 0 And RowCells <> 0 Then Coll.ADD RowCells, CStr(RowCells)
        Next
      Next
      .Replace "#N/A", Coll(Index), xlWhole
    End With
  Loop
Whoops:
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub

 

[JF123]

Rick,

Excellent this also works now and yes is very fast. I have over 1400 rows, in 8 columns.

How difficult would it be to:

1) Exclude Column A
2) Export the highlighted rows to a new sheet
3) Remove the highlighted rows from the first original sheet?

JF