vba require to populate array with a row position

[montecarlo2012]

Hello.
I have a dynamic array at B2:G, and I am looking forward for code able to populate a new array on S:X base on the row position of every number by row.
let me explain.

in this images for example
The number 1332 if I count from the next row, then this number was four rows away, and number four will be place on S2.
The next number 13320 also count it from the next row, was three rows away, then number 3 will be at T2 and so on for every number on the array until the lastRow.
so every time the count number will populate a new array on S:X
so here it is the actual numbers
<tbody>

1332​	13320​	15984​	17316​	25308​	31968​
4662​	7992​	8658​	12654​	17316​	29970​
3996​	9990​	11988​	13320​	26640​	27306​
7992​	13320​	15318​	24642​	31968​	33966​
1332​	2664​	3996​	7326​	10656​	25308​
17316​	21978​	25308​	27972​	29304​	32634​
12654​	28638​	29970​	30636​	31968​	33300​
3330​	5328​	15318​	16650​	18648​	23310​
6660​	15318​	17982​	21312​	28638​	33300​
1332​	19980​	21312​	27306​	33966​	34632​
17982​	21312​	23976​	25308​	28638​	33300​
1998​	5994​	9324​	13320​	14652​	27972​
666​	7992​	11988​	15318​	15984​	29970​
11988​	13986​	17982​	20646​	25308​	34632​
3996​	11988​	14652​	21312​	23310​	33966​
17982​	22644​	27306​	29970​	31968​	33300​
5994​	6660​	14652​	17982​	21312​	29304​
3330​	9990​	11988​	22644​	24642​	31302​
3996​	15318​	21312​	21978​	27972​	32634​
10656​	19980​	25308​	28638​	33966​	35298​
3996​	17316​	25308​	27306​	27972​	31302​
4662​	10656​	16650​	21978​	28638​	30636​
3996​	7992​	10656​	17982​	19980​	29304​
6660​	12654​	13320​	16650​	19314​	25308​
5328​	15318​	16650​	22644​	32634​	35298​
1332​	3330​	4662​	20646​	24642​	28638​
7992​	11988​	18648​	22644​	26640​	35298​
666​	7992​	21978​	24642​	26640​	33966​
6660​	11322​	11988​	13320​	19980​	27306​
666​	3330​	5994​	15318​	15984​	31302​
10656​	14652​	21978​	24642​	26640​	27306​
4662​	7326​	9324​	9990​	15318​	25308​
23310​	24642​	25974​	30636​	31968​	34632​
1998​	9324​	14652​	31302​	33300​	35298​
7992​	8658​	25974​	27306​	29304​	33300​
1998​	4662​	26640​	27972​	30636​	33966​
666​	1332​	8658​	20646​	21978​	35298​
666​	8658​	17982​	21978​	27306​	33966​

</tbody>
I was using this code but it is not what I need, it is not real practical for the application I am working on

Sub Left_to_right_count()
Dim Rng As Range, Ac&, Rw&
Dim Ray
Dim Q
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp)).Resize(, 6)
               Ray = Rng.Value
                           With CreateObject("scripting.dictionary")
                                       .CompareMode = vbTextCompare
                                       ReDim nRay(1 To UBound(Ray, 1), 1 To UBound(Ray, 2))
                                                   For Rw = 1 To UBound(Ray, 1)
                                                                  For Ac = 1 To UBound(Ray, 2)
                                                                                 If Not .Exists(Ray(Rw, Ac)) Then
                                                                                             .Add Ray(Rw, Ac), Array(Rw, Ac, (Rw - 1) * UBound(Ray, 2))
                                                                                             Else
                                                                                             Q = .Item(Ray(Rw, Ac))
                                                                                             nRay(Q(0), Q(1)) = ((Rw - 1) * UBound(Ray, 2) + Ac) - Q(2)
                                                                                             Q(2) = (Rw - 1) * UBound(Ray, 2)
                                                                                             Q(0) = Rw
                                                                                             Q(1) = Ac
                                                                                             .Item(Ray(Rw, Ac)) = Q
                                                                                 End If
                                                                  Next Ac
                                                   Next Rw
                                       Range("H1").Resize(UBound(Ray, 1), UBound(Ray, 2)) = nRay
                           End With
End Sub
this code count from left to right until found the number and replace in the next array, but this is exactly what I don't need.

thanks.

 

[DanteAmor]

According to your image, the data starts in cell L2, if not, the code can be adapted.
Try this.

Sub PopulatePosition()
  Dim i As Long, j As Long, lr As Long
  Dim r As Range, f As Range

  lr = Range("L" & Rows.Count).End(3).Row
  For i = 2 To lr - 1
    Set r = Range("L" & i + 1 & ":Q" & lr)
    For j = Columns("L").Column To Columns("Q").Column
      Set f = r.Find(Cells(i, j), , xlValues, xlWhole)
      If Not f Is Nothing Then
        Cells(i, j + 7) = f.Row - i
      End If
    Next
  Next
End Sub

Results:

Dante Amor
	L	M	N	O	P	Q	R	S	T	U	V	W	X
1
2	1332	13320	15984	17316	25308	31968		4	2	12	1	4	3
3	4662	7992	8658	12654	17316	29970		20	2	33	5	4	5
4	3996	9990	11988	13320	26640	27306		2	15	10	1	24	7
5	7992	13320	15318	24642	31968	33966		9	8	4	14	3	6
6	1332	2664	3996	7326	10656	25308		5		10	27	15	1
7	17316	21978	25308	27972	29304	32634		15	13	5	6	11	13
8	12654	28638	29970	30636	31968	33300		17	2	6	15	9	2
9	3330	5328	15318	16650	18648	23310		10	17	1	14	19	7
10	6660	15318	17982	21312	28638	33300		8	4	2	1	2	2
11	1332	19980	21312	27306	33966	34632		16	10	1	6	5	4
12	17982	21312	23976	25308	28638	33300		3	4		3	9	5
13	1998	5994	9324	13320	14652	27972		22	5	20	12	3	7
14	666	7992	11988	15318	15984	29970		15	10	2	6	17	3
15	11988	13986	17982	20646	25308	34632		1		2	12	6	19
16	3996	11988	14652	21312	23310	33966		4	3	2	2	18	5
17	17982	22644	27306	29970	31968	33300		1	2	5		17	18
18	5994	6660	14652	17982	21312	29304		13	7	14	6	2	6
19	3330	9990	11988	22644	24642	31302		8	14	9	7	8	3
20	3996	15318	21312	21978	27972	32634		2	6		3	2	6
21	10656	19980	25308	28638	33966	35298		2	3	1	2	8	5
22	3996	17316	25308	27306	27972	31302		2		3	8	15	9
23	4662	10656	16650	21978	28638	30636		4	1	2	6	4	11
24	3996	7992	10656	17982	19980	29304			4	8	15	6	12
25	6660	12654	13320	16650	19314	25308		5		5	1		8
26	5328	15318	16650	22644	32634	35298			5		2		2
27	1332	3330	4662	20646	24642	28638		11	4	6	11	2
28	7992	11988	18648	22644	26640	35298		1	2			1	7
29	666	7992	21978	24642	26640	33966		2	7	3	3	3	8
30	6660	11322	11988	13320	19980	27306							2
31	666	3330	5994	15318	15984	31302		7			2		4
32	10656	14652	21978	24642	26640	27306			3	6	2	5	4
33	4662	7326	9324	9990	15318	25308		4		2
34	23310	24642	25974	30636	31968	34632				2	3
35	1998	9324	14652	31302	33300	35298		2				1	3
36	7992	8658	25974	27306	29304	33300			2		3
37	1998	4662	26640	27972	30636	33966							2
38	666	1332	8658	20646	21978	35298		1		1		1
39	666	8658	17982	21978	27306	33966
Hoja4

 

[montecarlo2012]

Hello, thank you DanteAmor for your reply but what I got is an extra column,

Sub PopulatePosition()
  Dim i As Long, j As Long, lr As Long
  Dim r As Range, f As Range

  lr = Range("B" & Rows.Count).End(3).Row
  For i = 2 To lr - 1
    Set r = Range("B" & i + 1 & ":k" & lr)
    For j = Columns("B").Column To Columns("k").Column
      Set f = r.Find(Cells(i, j), , xlValues, xlWhole)
      If Not f Is Nothing Then
        Cells(i, j + 7) = f.Row - i
      End If
    Next
  Next
End Sub

I change L for K trying to get the new position but, wrong move, beside when I try in the original sheet, I have extra column after G and this code was reading everything instead of just the array ("B2:G"),
please can you check for me
this time I upload the image according to my sheet B2: until the end G thanks.

 

[DanteAmor]

Set r = Range("B" & i + 1 & ":k" & lr)
For j = Columns("B").Column To Columns("k").Column

Must be G

Try this

Sub PopulatePosition()
  Dim i As Long, j As Long, lr As Long
  Dim r As Range, f As Range
  
  lr = Range("B" & Rows.Count).End(3).Row
  For i = 2 To lr - 1
    Set r = Range("B" & i + 1 & ":G" & lr)
    For j = Columns("B").Column To Columns("G").Column
      Set f = r.Find(Cells(i, j), , xlValues, xlWhole)
      If Not f Is Nothing Then
        Cells(i, j + 7) = f.Row - i
      End If
    Next
  Next
End Sub

 

[montecarlo2012]

DanteAmor, Thank you so much for your help.
for me and I know for so many people here you are a Microsoft Most Valuable Professional, you really deserve to be MVP.
Thank you, you really know programming and you help anybody with any problem, I hope the best for you
My dear MVP.

 

[DanteAmor]

I'm glad to help you. I appreciate your kind comments.