["VBA"] comparing 8 arrays against 1

[montecarlo2012]

Hi, I am comparing 8 arrays against one, but in order to get some results, the code I have, I need to block many line and live only one unblock, Please any help here.
this is the code:

Sub com_eight()


  Dim a As Variant, b As Variant
  Dim r As Range, i As Range, j As Range, k As Long
  
  Application.ScreenUpdating = False
  
 ' Set r = Sheets("Sheet1").Range("H2:L" & Sheets("Sheet1").Range("H:L").Find("*", , xlValues, , 1, 2).Row)
  'Set r = Sheets("Sheet1").Range("N2:R" & Sheets("Sheet1").Range("N:R").Find("*", , xlValues, , 1, 2).Row)
 ' Set r = Sheets("Sheet1").Range("T2:X" & Sheets("Sheet1").Range("T:X").Find("*", , xlValues, , 1, 2).Row)
 'Set r = Sheets("Sheet1").Range("Z2:AD" & Sheets("Sheet1").Range("Z:AD").Find("*", , xlValues, , 1, 2).Row)
 'Set r = Sheets("Sheet1").Range("AF2:AJ" & Sheets("Sheet1").Range("AF:AJ").Find("*", , xlValues, , 1, 2).Row)
 'Set r = Sheets("Sheet1").Range("AL2:AP" & Sheets("Sheet1").Range("AL:AP").Find("*", , xlValues, , 1, 2).Row)
 'Set r = Sheets("Sheet1").Range("AR2:AV" & Sheets("Sheet1").Range("AR:AV").Find("*", , xlValues, , 1, 2).Row)
 Set r = Sheets("Sheet1").Range("AX2:BB" & Sheets("Sheet1").Range("AX:BB").Find("*", , xlValues, , 1, 2).Row)
 
  r.Interior.ColorIndex = 0
  For Each i In r.Rows
    k = 0
    For Each j In i.Columns
    
    
      If j.Value = Sheets("Sheet1").Range("B" & j.Row).Offset(, k).Value Then j.Interior.ColorIndex = 6
      k = k + 1
    Next
  Next
  
  Application.ScreenUpdating = True
End Sub

as you see I have seven lines block, and work like this is a little, you know, so, how is possible make it work,
thanks.

 

[DanteAmor]

Try this:

Sub com_eight()
  Dim r As Range, i As Range, j As Range
  Dim lr As Long, k As Long
  
  Application.ScreenUpdating = False
  
  With Sheets("Sheet1")
    lr = .Range("A:BB").Find("*", , xlValues, , 1, 2).Row
    Set r = Intersect(.Range("H2:BB" & lr), .Range("H:L, N:R, T:X, Z:AD, AF:AJ, AL:AP, AR:AV, AX:BB"))
    r.Interior.ColorIndex = 0
    For Each i In r.Rows
      k = 2
      For Each j In i.Columns
        If j.Value = .Cells(j.Row, k).Value Then j.Interior.ColorIndex = 6
        k = k + 1
        If k = 7 Then k = 2
      Next
    Next
  End With
  
  Application.ScreenUpdating = True
End Sub

 

[montecarlo2012]

Great Job, thank you, work perfect,
You are the best of the best.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.