["VBA"] >return a value from an “ADJACENT” formatting color cell

[montecarlo2012]

I am trying to figure out if there is a “VBA” way I can return a value from an “ADJACENT” formatting color cell.
All the place headers are adjacent to yesno headers.

Column K is a place value, column L is the formatting color values
Column N is a place value, column O is the formatting color values
Column Q is a place value, column R is the formatting color values
Column T is a place value, column U is the formatting color values

I’m looking for populate in sheet 2 the values on the place columns like this

This is an image of what I am trying to do:

I’m looking to populate in sheet 2 the values on the Label “place”, like this:

From Column K is a place value, column L is the formatting color values, I populate sheet2(“B2:G2”) with 1.10.11.17.30
Column N is a place value, column O is the formatting color values are populate (“B3:G3”) with 2.3.10.15.30 and so on

<tbody>

K​

L​

M​

N​

O​

P​

Q​

R​

S​

T​

U​

V​

W​

X​

Y​

Z​

AA​

AB​

AC​

AD​

AE​

place​

yesno​

RANK​

place​

yesno​

RANK​

place​

yesno​

RANK​

place​

yesno​

RANK​

place​

yesno​

RANK​

place​

yesno​

RANK​

place​

yesno​

RANK​

1​

42​

2​

1​

17​

2​

1​

24​

2​

1​

10​

2​

1​

24​

3​

1​

24​

3​

1​

24​

2​

2​

2​

1​

2​

34​

2​

2​

3​

1​

2​

24​

2​

2​

45​

3​

2​

45​

3​

2​

26​

2​

3​

3​

1​

3​

42​

2​

3​

10​

1​

3​

45​

2​

3​

21​

2​

3​

10​

2​

3​

45​

2​

4​

4​

1​

4​

3​

1​

4​

13​

1​

4​

17​

1​

4​

33​

2​

4​

26​

2​

4​

6​

1​

5​

6​

1​

5​

10​

1​

5​

17​

1​

5​

21​

1​

5​

48​

2​

5​

30​

2​

5​

10​

1​

6​

13​

1​

6​

13​

1​

6​

21​

1​

6​

22​

1​

6​

52​

2​

6​

41​

2​

6​

21​

1​

7​

17​

1​

7​

22​

1​

7​

22​

1​

7​

26​

1​

7​

10​

1​

7​

21​

1​

7​

28​

1​

8​

24​

1​

8​

24​

1​

8​

32​

1​

8​

30​

1​

8​

26​

1​

8​

33​

1​

8​

30​

1​

9​

31​

1​

9​

31​

1​

9​

33​

1​

9​

33​

1​

9​

30​

1​

9​

48​

1​

9​

33​

1​

10​

32​

1​

10​

32​

1​

10​

34​

1​

10​

34​

1​

10​

41​

1​

10​

52​

1​

10​

35​

1​

11​

34​

1​

11​

37​

1​

11​

41​

1​

11​

41​

1​

11​

1​

0​

11​

1​

0​

11​

41​

1​

12​

37​

1​

12​

41​

1​

12​

42​

1​

12​

42​

1​

12​

2​

0​

12​

2​

0​

12​

43​

1​

13​

41​

1​

13​

43​

1​

13​

43​

1​

13​

43​

1​

13​

3​

0​

13​

3​

0​

13​

48​

1​

14​

43​

1​

14​

45​

1​

14​

45​

1​

14​

48​

1​

14​

4​

0​

14​

4​

0​

14​

51​

1​

15​

45​

1​

15​

53​

1​

15​

48​

1​

15​

52​

1​

15​

5​

0​

15​

5​

0​

15​

52​

1​

16​

51​

1​

16​

1​

0​

16​

52​

1​

16​

1​

0​

16​

6​

0​

16​

6​

0​

16​

1​

0​

17​

53​

1​

17​

2​

0​

17​

53​

1​

17​

2​

0​

17​

7​

0​

17​

7​

0​

17​

2​

0​

18​

1​

0​

18​

4​

0​

18​

1​

0​

18​

3​

0​

18​

8​

0​

18​

8​

0​

18​

3​

0​

19​

5​

0​

19​

5​

0​

19​

2​

0​

19​

4​

0​

19​

9​

0​

19​

9​

0​

19​

4​

0​

20​

7​

0​

20​

6​

0​

20​

4​

0​

20​

5​

0​

20​

11​

0​

20​

11​

0​

20​

5​

0​

21​

8​

0​

21​

7​

0​

21​

5​

0​

21​

6​

0​

21​

12​

0​

21​

12​

0​

21​

7​

0​

22​

9​

0​

22​

8​

0​

22​

6​

0​

22​

7​

0​

22​

13​

0​

22​

13​

0​

22​

8​

0​

23​

10​

0​

23​

9​

0​

23​

7​

0​

23​

8​

0​

23​

14​

0​

23​

14​

0​

23​

9​

0​

24​

11​

0​

24​

11​

0​

24​

8​

0​

24​

9​

0​

24​

15​

0​

24​

15​

0​

24​

11​

0​

25​

12​

0​

25​

12​

0​

25​

9​

0​

25​

11​

0​

25​

16​

0​

25​

16​

0​

25​

12​

0​

26​

14​

0​

26​

14​

0​

26​

11​

0​

26​

12​

0​

26​

17​

0​

26​

17​

0​

26​

13​

0​

27​

15​

0​

27​

15​

0​

27​

12​

0​

27​

13​

0​

27​

18​

0​

27​

18​

0​

27​

14​

0​

28​

16​

0​

28​

16​

0​

28​

14​

0​

28​

14​

0​

28​

19​

0​

28​

19​

0​

28​

15​

0​

29​

18​

0​

29​

18​

0​

29​

15​

0​

29​

15​

0​

29​

20​

0​

29​

20​

0​

29​

16​

0​

30​

19​

0​

30​

19​

0​

30​

16​

0​

30​

16​

0​

30​

22​

0​

30​

22​

0​

30​

17​

0​

</tbody>
after I search in this forum for the word "adjacent", among the 210 post, I didn't found my case, but I saw like the concept in a code, again this is illustration ONLY

Sub sh1_to_sh2()
Dim Cl As Range
For Each Cl In Range("K2", Range("K" & Rows.Count).End(xlUp))
If Cl.DisplayFormat.Interior.Color = vbYellow Then

Populate sheet 2(“B2:G2”)
Populate sheet 2(“B3:G3”)

Etc.etc.
End If
Next Cl
End Sub

 

[Fluff]

How about

Sub montecarlo()
   Dim Cl As Range
   Dim i As Long, j As Long, r As Long, c As Long
   
   i = 1
   j = 1
   With Sheets("Sheet1")
      For c = 11 To 29 Step 3
      j = j + 1
         For r = 1 To 31
            If .Cells(r, c + 1).Interior.ColorIndex <> xlNone Then
               i = i + 1
               Sheets("Sheet2").Cells(j, i) = .Cells(r, c)
            End If
         Next r
         i = 1
      Next c
   End With
End Sub

 

[montecarlo2012]

Fluff, Your are "REMARKABLE" thank you so much.
work perfect.
Moments like this make me feel I have to move to England and get lesson from a person like you.

 

[Fluff]

You're welcome & thanks for the feedback.

 

[montecarlo2012]

You're welcome & thanks for the feedback.

Just a little question. There are suggestion about how to ask, one of them is be short or specific, I understand the member has to build up a small example, have sense, but in this case I think I when so small.
for that reason when I plug in the code in the real workbook I got some differences, Do you mind if I load my diff, sorry.
I perfectly understand if this section is done, thank you Sir.

 

[Fluff]

If you post your real data I will look at it.

 

[montecarlo2012]

Thank you Sir, for your Understanding.
first this is what I change in the code:

Sub montecarlo()
   Dim Cl As Range
   Dim i As Long, j As Long, r As Long, c As Long
   
   i = 1
   j = 1
   With Sheets("Sheet1")
      For c = 14 To 309 Step 3
      j = j + 1
         For r = 2 To 310
            If .Cells(r, c + 1).Interior.ColorIndex <> xlNone Then
               i = i + 1
               Sheets("Sheet7").Cells(j, i) = .Cells(r, c)
            End If
         Next r
         i = 1
      Next c
   End With
End Sub

this is the answer I got on sheet7:

comparing with the original sheet1

on column N (or 14) the numbers to copy are 3-13-17-18-20-52, this is the vales to place on sheet7 B2:G2, next column Q (17) equal to 5-10-12-14-41-44.
would be like:

on sheet 7
Thank you Sir.

 

[Fluff]

How are the cells being coloured?

 

[montecarlo2012]

The cells are coloring by a code, or conditional formatting

 With Selection.FormatConditions
    .Add Type:=xlExpression, Formula1:="=COUNTIF($B$" & i - 1 & ":$G$" & i - 1 & "," & c & "2)"

 

[Fluff]

In that case try

            If .Cells(r, c + 1).DisplayFormat.Interior.ColorIndex <> xlNone Then