VBA Macro to Expand Selection to Adjacent Cells With Same Value

[nekosuke]

Hi guys!
I'm having a tough problem. When I select a cell in a table with a certain value, I want all the cells adjacent to that selected cell with the same value to also be selected. After that, the cells adjacent to the newly selected cells that have the same value are also selected.

Can anyone please tell me how this is done on VBA? What is the code for this? I've been trying things for hours, but I haven't even come close. Thanks!

 

[Peter_SSs]

Welcome to the MrExcel board!

1. Can you give us some idea of where the top left of the table is and about how many rows/columns?

2. If, say, C4 and D5 contain the same value, do you consider them adjacent? That is, are touching diagonal corners considered adjacent?

3. Are there blank cells in the table? If so, how do we determine where the edges of the table are?

 

[nekosuke]

Welcome to the MrExcel board!

1. Can you give us some idea of where the top left of the table is and about how many rows/columns?

2. If, say, C4 and D5 contain the same value, do you consider them adjacent? That is, are touching diagonal corners considered adjacent?

3. Are there blank cells in the table? If so, how do we determine where the edges of the table are?

1. Our table size is Range(Cells(2,2), Cells(17,13))

2. No, the adjacent cells are only vertical and horizontal.

3. We already gave a definite value for the size of our table. The cells are actually coloured and they contain their corresponding .Interior.ColorIndex value.

 

[Peter_SSs]

Let's see if this does what you want.
To implement ..

1. Right click the sheet name tab and choose "View Code".

2. Copy and Paste the code below into the main right hand pane that opens at step 1.

3. Close the Visual Basic window & test.

Note that the code assumes that the main table (B2:M17 in your case) does NOT border a worksheet boundary.
That is, if the main table starts in column A or row 1, the code will error in some circumstances.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim Tbl As Range, Ctr As Range, Rng As Range, Rtmp As Range, Ctest As Range, c As Range
  Dim v
  Dim Found As Boolean

  Set Tbl = Range("B2:M17")
  Set Ctr = ActiveCell
  If Not Intersect(Ctr, Tbl) Is Nothing Then
    Set Rtmp = Ctr
    v = Ctr.Value
    Do
      Set Rng = Rtmp
      Found = False
      For Each c In Rng
        For Each Ctest In Union(c.Offset(-1), c.Offset(1), _
                            c.Offset(, -1), c.Offset(, 1))
          If Not Intersect(Ctest, Tbl) Is Nothing Then
            If Intersect(Ctest, Rng) Is Nothing Then
              If Ctest.Value = v Then
                Set Rtmp = Union(Rtmp, Ctest)
                Found = True
              End If
            End If
          End If
        Next Ctest
      Next c
    Loop While Found
    Application.EnableEvents = False
    Rng.Select
    Ctr.Activate
    Application.EnableEvents = True
  End If
End Sub

As an example, if any one of the green cells below is selected, all those green cells will be selected. I hope that is what you meant.

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1
2		4	3	3	2	2	4	1	4	5	4	1	3
3		5	4	2	5	2	1	5	2	3	4	1	3
4		3	2	4	4	2	2	5	5	3	5	5	2
5		4	5	2	3	2	5	4	1	3	1	1	4
6		2	1	2	2	2	5	5	3	2	1	1	4
7		3	3	4	2	4	2	1	3	1	3	5	2
8		4	2	2	5	4	4	3	1	3	4	5	5
9		1	3	5	3	4	3	3	3	2	3	2	1
10		2	5	1	2	2	3	1	3	2	4	3	1
11		5	4	3	2	1	4	3	4	3	5	1	2
12		1	1	2	1	1	3	4	3	5	1	1	4
13		3	2	1	4	5	3	1	4	3	3	3	2
14		2	1	3	1	5	1	3	2	5	4	2	4
15		2	1	1	2	4	2	2	3	2	2	1	3
16		2	5	3	4	5	2	3	1	4	3	5	1
17		5	4	2	1	3	2	5	1	1	2	3	5
18
Adjacent Cells

 

[alexofrhodes]

Peter, I'm making some basic games for fun in excel, trying to learn a thing or two.
Found great help in your code, thanks, as i am making a game of Go.
With your code i check if the cells adjacent to where the last move was contains a chain that is alive or dead.