I need help with a macro please

[mrc44]

I have a data table (B:E) with values that looks something like this:

ID	DATA
48	5	7	10
47	4	3
46	6	11	21	30
45
44	1	8
43	1	2	3	5
42	2	5	6
41	12	13
etc

<tbody>
</tbody>

So the data table may have a maximum of 4 values. Some rows may have no data at all or less than 4 values as can be seen in the sample data
above. I need to calculate and get a count of variations/ deviations (within the range of -1,0,+1) among the rows. (-1/+1 if there is 1 one difference between two values of compared rows, and 0 if the values are the same).

So as an example, if you compare the first two rows above, 4 and 5 are in +1/-1 range. the others are not in range. so count is 1 for this comparison. if we compare the first and third rows, 5 and 6, 6 and 7, 10 and 11 are in +1/-1 range again. so count is 3.
Expected results would look like this:

EXPECTED RESULTS
ID	47	46	45	44	43	42	41	40	etc
48	1	3	0	1	1	2	0
47		0	0	0
46
45
44
43

<tbody>
</tbody>

Can I get help to achieve this result please? The results don't have to be on the same page. thank you!
This is a sample file : https://1drv.ms/x/s!AsEuzEWSPBGqeyC5dokD4mMgr3w

 

[Rijnsent]

Hi mrc,
after messing around with formulas and array formulas I arrived at a very long formula that gave me the results, but I get why you want a macro, as that's much easier. Did you already generate some code? If not, this function should do the trick:

Function DiffMax(Rng1 As Range, Rng2 As Range, Optional MaxDiff As Double = 1) As Long

Res = 0
If Rng1.Cells.Count >= 1 And Rng2.Cells.Count >= 1 Then
    For Each c1 In Rng1.Cells
        If Trim(c1.Value) <> "" Then
            For Each c2 In Rng2.Cells
                If Trim(c2.Value) <> "" Then
                    If Abs(c1.Value - c2.Value) <= MaxDiff Then
                        Res = Res + 1
                    End If
                End If
            Next c2
        End If
    Next c1
End If
DiffMax = Res

End Function

After that, this is the formula in your example sheet, first cell in your results table, you can drag it to the other cells.
=DiffMax($B3:$E3,OFFSET($B$4:$E$4,COLUMN()-8,0))


Cheers,

Koen

 

[mrc44]

Thanks, Koen! I tried your code, it generates the results as expected. Since it is an array of values, and there are null cells too, I thought it'd be too problematic, and may not doable at all. And I wouldn't be able to write the vba code for this function. thanks for your help and time!