Scan 8 adjacent cells

methody

Well-known Member
Joined
Jun 17, 2002
Messages
845
Hi
I have a range with 200 cells -20 row and 10 columns. Each cell is either blank or has a unique number in the cell. Moving across each row, there can be a maximum of 8 adjacent non-empty cells.
I am looking for a macro that will scan the range of cells, look for the instances of 8 adjacent cells and return the unique number which is in the leftmost cell of each of the cases of 8 adjacents.

As if that isn't tricky enough i am also looking for a separate list for the leftmost cell where there are only 7 adjacents. Here it would be where there are 7 only. I appreciate that this is difficult as there may be overlap.

Any help appreciated. sorry if this isn't clear.
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,729
Office Version
  1. 365
Platform
  1. Windows
Are the numbers hard values, or the result of a formula?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,729
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Sub methody()
   Dim Rw As Range, Ar As Range
   
   For Each Rw In Range("A1:J20").Rows
      For Each Ar In Rw.SpecialCells(xlConstants).Areas
         If Ar.Count = 7 Then
            Range("N" & Rows.Count).End(xlUp).Offset(1).Value = Ar(1).Value
         ElseIf Ar.Count = 8 Then
            Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Ar(1).Value
         End If
      Next Ar
   Next Rw
End Sub
I've assumed that your numbers are in A1:J20
 

JamesCanale

Board Regular
Joined
Jan 13, 2021
Messages
159
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS

ADVERTISEMENT

No VB approach
MrExcelPlayground.xlsm
ABCDEFGHIJKL
18 blanks7 blanks
2453456521NoneNone
3444
424354121None243
5323232
6555
75465NoneNone
8124512451245
956214None56
10NoneNone
11NoneNone
12434343
1375321None75
14868686
1545NoneNone
16NoneNone
17575757
18NoneNone
1934512345345
20NoneNone
2134512None345
Sheet23
Cell Formulas
RangeFormula
K2:K21K2=IF(OR(SUMPRODUCT(--(B2:I2=""))=8,SUMPRODUCT(--(C2:J2=""))=8),IF(A2="",IF(B2="","None",B2),A2),"None")
L2:L21L2=IF(OR(SUMPRODUCT(--(B2:H2=""))=7,SUMPRODUCT(--(C2:I2=""))=7,SUMPRODUCT(--(D2:J2=""))=7),IF(A2="",IF(B2="",IF(C2="","None",C2),B2),A2),"None")
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,729
Office Version
  1. 365
Platform
  1. Windows
This will put the starting numbers in the same row as the data
VBA Code:
Sub methody()
   Dim Rw As Range, Ar As Range
   
   For Each Rw In Range("A1:J20").Rows
      For Each Ar In Rw.SpecialCells(xlConstants).Areas
         If Ar.Count = 7 Then
            Range("N" & Rw.Row).Value = Ar(1).Value
         ElseIf Ar.Count = 8 Then
            Range("M" & Rw.Row).Value = Ar(1).Value
         End If
      Next Ar
   Next Rw
End Sub
 

methody

Well-known Member
Joined
Jun 17, 2002
Messages
845
Hello Fluff
IThank you. I think you are close but I can't get any response when I run your code. For the grid below I have shown the result I am looking for on the right
1613848366077.png


1613848366077.png

THank you
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,729
Office Version
  1. 365
Platform
  1. Windows
Is your data in A1:J20?
And was that the activesheet when you ran the macro?
 

Watch MrExcel Video

Forum statistics

Threads
1,129,917
Messages
5,638,981
Members
417,061
Latest member
thematulaak

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top