Highlighting a cell if there is a match with another cell

[Mati44]

I have a sample xlsm data table attached. In the file, there is a range of cells with comma separated different numbers. I am seeking a function that if a cell has a value +1 or -1 of a value in the cell right below in the same column, then the upper cell changes to green color.


For example, in the sample file A1 has 100, A2 has 101. Since 100 is -1 of A2, A1 should be set to green.
Again, in D22 has 221 and D23 has 220. since D22 is +1 of D23, D22 should set to green color.

So this should apply to the whole range of cells given in the example. It would be great to apply the code only to a part of the sheet with relevant data, instead of the entire sheet.

Sample File: Sample +1-1.xlsm

[offthelip]

this should do it i think:

Sub test()
inarr = Range(Cells(1, 1), Cells(25, 7))
' go through the rows
For i = 1 To 24
' go through the columns
 For j = 1 To 7
    If IsNumeric(inarr(i, j)) Then
      ' single value on top
        If IsNumeric(inarr(i + 1, j)) Then
          ' single value on bottom
          found1 = (Abs(inarr(i, j) - inarr(i + 1, j))) = 1
          If found1 Then
           Cells(i, j).Interior.ColorIndex = 4
          End If
          
        Else
         ' singel on top multiple on bottom
         botarr = Split(inarr(i + 1, j), ",")
         For kk = 0 To UBound(botarr)
          found1 = (Abs(inarr(i, j) - botarr(kk))) = 1
          If found1 Then
           Cells(i, j).Interior.ColorIndex = 4
          End If
         Next kk
        End If
     ' multiple on top
    Else
     toparr = Split(inarr(i, j), ",")
     found1 = False
     For k = 0 To UBound(toparr)
        ' check lower value
        If IsNumeric(inarr(i + 1, j)) Then
          ' single value
          found1 = (Abs(toparr(k) - inarr(i + 1, j))) = 1
          If found1 Then
           Cells(i, j).Interior.ColorIndex = 4
          End If
          
        Else
         botarr = Split(inarr(i + 1, j), ",")
         For kk = 0 To UBound(botarr)
          found1 = (Abs(toparr(k) - botarr(kk))) = 1
          If found1 Then
           Cells(i, j).Interior.ColorIndex = 4
          End If
         Next kk
        End If
      Next k
      
    End If
 Next j
Next i


      
      
End Sub

If you want it to apply to just part of the sheet, just change the range in the :

inarr = Range(Cells(1, 1), Cells(25, 7))

statement

[p45cal]

beat me to it:

Sub blah()
Set myRng = Sheets("Sheet1").Range("A1").CurrentRegion
Set myRng = myRng.Resize(myRng.Rows.Count - 1)
For Each cll In myRng.Cells
  tc = Split(cll.Value, ",")
  bc = Split(cll.Offset(1).Value, ",")
  For Each t In tc
    For Each b In bc
      If Abs(CLng(Trim(t)) - CLng(Trim(b))) = 1 Then cll.Interior.Color = vbGreen
    Next b
  Next t
Next cll
End Sub

[Mati44]

Yes, this works great! Thanks a lot!

[Mati44]

This code works great too. and very short indeed. thanks a lot!

[Mati44]

Hi P45Cal and Offthelip, I tried your codes with a larger data sample, and I got errors on both cases. I tried to modify and fix it, but no luck. Can you look at the file, please? both of the macros are in the file with your names.
The actual data table is 16 columns and increasing row numbers currently about 1000. So I increased the data number in the file.Sample code for +1-1.xlsm

[offthelip]

My verson of the code works perfectly well provided you change the numbers correctly. I suspect you changed the loop number to 53 which will throw up an error, it should be 52 . This is because the code always looks at the row below as well as the current row, so it can't do the check on the very last row.
this works:

    inarr = Range(Cells(1, 1), Cells(53, 16))
     ' go through the rows
    For i = 1 To 52
         ' go through the columns
        For j = 1 To 16

[Mati44]

yes, I understand. thanks a lot.Actually, I changed these numbers before, probably I made a mistake then. Now it is ok.

[p45cal]

Your data starts in a different place. Change
Set myRng = Sheets("Sheet1").Range("A1").CurrentRegion
to:
Set myRng = Sheets("Sheet1").Range("A4").CurrentRegion

[Mati44]

I am sorry, that's a shame for me. I bother you for this. Thanks again.