Scan 8 adjacent cells

[methody]

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.

 

[methody]

Yes.
I think it doesn't like it if column 1 has empty cells. Is there any way of getting round that? You have already been a big help and were are nearly there

 

[Fluff]

Do you get any errors?

 

[methody]

Run time error 1004 no cells found

and this line goes yellow.

For Each Ar In Rw.SpecialCells(xlConstants).Areas

 

[Fluff]

You've got completely blank rows, which is causing the problem, try

Sub methody()
   Dim Rw As Range, Ar As Range
   
   For Each Rw In Range("A1:J20").Rows
      On Error Resume Next
      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
      On Error GoTo 0
   Next Rw
End Sub

 

[methody]

Sorry Fluff that was working perfectly but when I tested it further there is a problem. My range is bigger than what we have been using and therefore there can be more than one example of 8 adjacent or 7 adjacent in the same row. Or there could be more than one set of 8 and more than set of 7 in the same row. That poses greater difficulty. Ultimately I would want the leftmost numbers of all the 8 and 7's leftmost values gathered in the same column or row.

 

[Fluff]

My range is bigger than what we have been using

Then why on earth did you say.

I have a range with 200 cells -20 row and 10 columns.

 

[Fluff]

What is the actual range you are working with?
Also please post some sample data.

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

 

[methody]

Sorry about that

Book1.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP	AQ	AR	AS	AT	AU	AV	AW	AX	AY	AZ
1	A1	A2	A3	A4	A5	A6	A7	A8					A13	A14	A15	A16	A17	A18	A19	A20				A24	A25	A26	A27	A28	A29	A30	A31			A34	A35	A36	A37	A38	A39	A40	A41			A44	A45	A46	A47	A48	A49	A50	A51
2										B10	B11											B22
3	C1	C2	C3	C4	C5	C6	C7	C8					C13	C14	C15	C16	C17	C18	C19	C20				C24	C25	C26	C27	C28	C29	C30	C31				C35	C36	C37	C38	C39	C40	C41	C42			C45	C46	C47	C48	C49	C50	C51	C52
4										D10	D11											D22											D33
5	E1	E2	E3	E4	E5	E6	E7	E8					E13	E14	E15	E16	E17	E18	E19	E20				E24	E25	E26	E27	E28	E29	E30	E31				E35	E36	E37	E38	E39	E40	E41	E42			E45	E46	E47	E48	E49	E50	E51
6										F10	F11											F22											F33
7	G1	G2	G3	G4	G5	G6	G7	G8					G13	G14	G15	G16	G17	G18	G19	G20				G24	G25	G26	G27	G28	G29	G30	G31				G35	G36	G37	G38	G39	G40	G41	G42			G45	G46	G47	G48	G49	G50	G51
8
9	I1	I2	I3	I4	I5	I6	I7	I8			I11	I12	I13	I14	I15	I16	I17	I18			I21	I22	I23			I26	I27	I28	I29	I30	I31	I32	I33			I36	I37	I38	I39	I40	I41	I42	I43			I46	I47	I48	I49	I50	I51	I52
10
Sheet1

 

[Fluff]

Ok, how about

Sub methody()
   Dim Rw As Range, Ar As Range
   Dim Txt7 As String, Txt8 As String
   
   For Each Rw In Range("A1:AZ10").Rows
      On Error Resume Next
      For Each Ar In Rw.SpecialCells(xlConstants).Areas
         If Ar.Count = 7 Then
            Txt7 = Txt7 & "," & Ar(1).Value
         ElseIf Ar.Count = 8 Then
            Txt8 = Txt8 & "," & Ar(1).Value
         End If
      Next Ar
      On Error GoTo 0
      Range("BB" & Rw.Row) = Mid(Txt7, 2)
      Range("BC" & Rw.Row) = Mid(Txt8, 2)
      Txt7 = ""
      Txt8 = ""
   Next Rw
End Sub

 

[methody]

It's not kicking in at all. Tried playing about with top row and first column but not getting anything