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: 20105

[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.20112

[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.