0

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.

enter image description here

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
1

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
12
  • 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.
    – user761065
    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)
    – Jonathan
    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.
    – user761065
    Aug 22 '17 at 12:36
  • how do you compute 10 on O2
    – Jonathan
    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.
    – user761065
    Aug 22 '17 at 14:33
0

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)
                If (c.Address <> r.Address) * (c.Row > r.Row) Then
                    r.Offset(, 13) = c.Row - r.Row - 1
                Else
                    r.Offset(, 13) = "na"
                End If
            Next
        End With
    End With
End Sub 

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.