# Calculating distance (rows) between two same values on a table

I have a VBA Code to calculate the distance between two cells with same values on a table. I just need the row difference between the cells which can be on different columns as seen in the picture. I need only distance on the "Y" axis, not on the "X" axis. This code has the functionality and design that I need but it calculates distance on "X" axis too.

In the example picture below, in column B, B5:Central matches with the closest (down) B12:Central, and the distance ( the number of rows between them) is 6. And in E1:250 it matches with the nearest G16:250, and the distance is 13. The code I have is this:

``````Option Explicit

Sub main()
Dim cell As Range, f As Range
Dim rowOffset As Long

With Worksheets("gaps").Range("A2:F10") '<--| change this to your actual range of interest
For Each cell In .SpecialCells(xlCellTypeConstants, xlNumbers)
rowOffset = 1
Set f = .Find(what:=cell, after:=cell, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
If Not f Is Nothing And f.Row <= cell.Row Then rowOffset = cell.Row - f.Row + 1
cell.offset(, .Columns.Count + 1) = rowOffset '<--| the "+1" offset results range one column away from values range: adjust it as per your needs
Next cell
End With
End Sub
``````

Compute the rows

``````Sub main4()
Dim cell As Range, f As Range
Dim RowOffset As String
With Worksheets("gaps").Range("A2:F10") '<--| change this to your actual range of interest
For Each cell In .SpecialCells(xlCellTypeConstants, xlNumbers)
RowOffset = "na"
Set f = .Find(what:=cell, after:=cell, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
If (f.Row <> cell.Row) Or (f.Row <> cell.Row) Then RowOffset = f.Row - cell.Row
cell.Offset(, .Columns.Count + 1) = RowOffset '<--| the "+1" offset results range one Row away from values range: adjust it as per your needs
Next cell
End With
End Sub
``````

compute columns

``````Sub main2()
Dim cell As Range, f As Range
Dim ColOffset As String
With Worksheets("gaps").Range("A2:F10") '<--| change this to your actual range of interest
For Each cell In .SpecialCells(xlCellTypeConstants, xlNumbers)
ColOffset = "na"
Set f = .Find(what:=cell, after:=cell, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
If (f.Column <> cell.Column) Or (f.Row <> cell.Row) Then ColOffset = f.Column - cell.Column
cell.Offset(, .Columns.Count + 1) = ColOffset '<--| the "+1" offset results range one column away from values range: adjust it as per your needs
Next cell
End With
End Sub
``````

Or even better you can indicate both row and column in the cell:

``````Sub main3()
Dim cell As Range, f As Range
Dim Offset As String

With Worksheets("gaps").Range("A2:F10") '<--| change this to your actual range of interest
For Each cell In .SpecialCells(xlCellTypeConstants, xlNumbers)
Offset = "na"
Set f = .Find(what:=cell, after:=cell, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
If (f.Column <> cell.Column) Or (f.Row <> cell.Row) Then Offset = (f.Column - cell.Column) & ";" & (f.Row - cell.Row)
cell.Offset(, .Columns.Count + 1) = Offset '<--| the "+1" offset results range one column away from values range: adjust it as per your needs
Next cell
End With
End Sub
``````
• Thanks for your suggestions. I tried both of them. The first one is what I really need. but It outputs many NA, -1, -2 ,1,0,2. I think it matches single digits with double digit numbers too. For example, it seems to match 2 with 12, or 20 etc. I seek an exact match and when the code finds it, it brings the number of rows between the main cell and target cell. Aug 22 '17 at 10:04
• if you use main3() you will be able to locate exactly what cell matches to what cell. please give the two matches that does not work. (it works fine on my side and "na" is for no match found) Aug 22 '17 at 12:13
• I prepared a sample data workbook 1drv.ms/x/s!AoGkZUHlKui9gQ8NBaB1fllfYkXi Here you can see the results I get for main2, and the expected results for the first two rows. Aug 22 '17 at 12:36
• how do you compute 10 on O2 Aug 22 '17 at 13:36
• C2:3 and C13: 3, between them 10 rows. I updated the picture in the question, it's shown there. Aug 22 '17 at 14:33

Here is a solution I found to this problem addressing the issues I had in the codes offered.

``````Sub Intervals()
Dim r As Range, c As Range
With Cells(1).CurrentRegion
With .Offset(1).Resize(.Rows.Count - 1)
For Each r In .Cells
Set c = .Find(r.Value, r, , 1, , , 2)