Formula or VBA for Cell Range of Values

[ststern45]

Hi everyone.

I have a range of 40 cells and in these 40 cells are a total of 4 values from 0 through 9.
The 40 cells will always have 4 values. No more no less.
If the 4 values in the 40 cells all touch either horizontal, vertically, etc. As long as each value touches one another.
Image 1:
Example where all 4 numbers touch each other.
The values 2-0-1-3 all touch. If the 4 numbers touch then a value of 1. If they don't a value of 0

Image 2:
1 or more numbers do not touch.
In this case the result would be false and a value of 0 (zero)
Even though the values 2, 0, and 5 touch the 4 does not so the result would be false of the value 0 (zero)

Thank you in advance!!

 

[Eric W]

Maybe:

Book1
	A	B	C	D	E	F	G	H	I	J	K
1	P1	P2	P3	P4	All Touch?		P1	P2	P3	P4	All Touch?
2	2	0	1	3	1		2	0			0
3							5			4
4
5
6
7
8
9
10
11
Sheet7

Cell Formulas
Range	Formula
E2,K2	E2	=LET(t,SMALL(IF(A2:D11<>"",ROW(A2:D11)*100+COLUMN(A2:D11),""),{1;2;3;4}),a,t+{-1,1,-100,100},b,SMALL(a,SEQUENCE(16)),PRODUCT(ISNUMBER(MATCH(t,b,0))+0))

 

[ststern45]

Thank you Eric.
Formula works great but I made an error in my initial post.
If a cell is touches diagonal, this should also be included.
See image
Thank you.

 

[ststern45]

In addition, this would also qualify since a values touch diagonally.

See image
Thank you

 

[Eric W]

OK, try:

=LET(t,SMALL(IF(A2:D11<>"",ROW(A2:D11)*100+COLUMN(A2:D11),""),{1;2;3;4}),a,t+{-1,1,-100,100,101,99,-101,-99},b,SMALL(a,SEQUENCE(32)),PRODUCT(ISNUMBER(MATCH(t,b,0))+0))

I should probably also mention that this won't work past column CU, but it can be adjusted if that's an issue.

 

[Alex Blakenburg]

I thought Eric's formula solution was probably the way to go and his skill level is well beyond mine.
Since I did manage to break the lastest formula with the data arangement below, and the problem sounds like the definition of current region I thought I would provide a VBA option.

s/be 0

VBA option

Sub TouchingValues()

    Dim ws As Worksheet
    Dim rngSrc As Range, rngResult
    Dim rngDest As Range, cellFound As Range
  
    Set ws = ActiveSheet
    With ws
        Set rngSrc = .Range("A2").Resize(10, 4)             '<--- Change this to the first Data cell ie left top corner below heading
        Set rngResult = rngSrc.Cells(1, 1).Offset(, 5)      '<--- Based on your image this is the offset to the result cell
        Set rngDest = .UsedRange.Cells(1, 1).Offset(, .UsedRange.Columns.Count + 2).Resize(rngSrc.Rows.Count, rngSrc.Columns.Count)
      
        rngDest.Value = rngSrc.Value
        On Error Resume Next
        Set cellFound = rngDest.Find(what:="*")
        On Error GoTo 0
        If cellFound Is Nothing Then
            MsgBox "No Data In Data area"
            Exit Sub
        End If
      
        If WorksheetFunction.CountA(cellFound.CurrentRegion) = 4 Then
            rngResult.Value = 1
        Else
            rngResult.Value = 0
        End If
      
        rngDest.Clear
      
        Dim resetUsedRange As Long
        resetUsedRange = ws.UsedRange.Row
        
    End With
  
End Sub

 

[ststern45]

Thank you both
I will try the formula and VBA later today and give an update.

 

[ststern45]

All 4 values must touch vertically, horizontally, diagonally.
See image
Only 2 values touch in the image
Sorry for the reply.
Thank you

 

[Alex Blakenburg]

Did you try the code ?

 

[Eric W]

I know what the problem is, but I don't know how to fix it right away. I'll think on it. It might be a few days since I'm traveling. In the meantime, see if Alex's code works for you.