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.
 

methody

Well-known Member
Joined
Jun 17, 2002
Messages
845
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
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,541
Office Version
  1. 365
Platform
  1. Windows
Do you get any errors?
 

methody

Well-known Member
Joined
Jun 17, 2002
Messages
845
Run time error 1004 no cells found

and this line goes yellow.

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

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,541
Office Version
  1. 365
Platform
  1. Windows
You've got completely blank rows, which is causing the problem, try
VBA Code:
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

Well-known Member
Joined
Jun 17, 2002
Messages
845

ADVERTISEMENT

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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,541
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

Well-known Member
Joined
Jun 17, 2002
Messages
845
Sorry about that

Book1.xlsx
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAOAPAQARASATAUAVAWAXAYAZ
1A1A2A3A4A5A6A7A8A13A14A15A16A17A18A19A20A24A25A26A27A28A29A30A31A34A35A36A37A38A39A40A41A44A45A46A47A48A49A50A51
2B10B11B22
3C1C2C3C4C5C6C7C8C13C14C15C16C17C18C19C20C24C25C26C27C28C29C30C31C35C36C37C38C39C40C41C42C45C46C47C48C49C50C51C52
4D10D11D22D33
5E1E2E3E4E5E6E7E8E13E14E15E16E17E18E19E20E24E25E26E27E28E29E30E31E35E36E37E38E39E40E41E42E45E46E47E48E49E50E51
6F10F11F22F33
7G1G2G3G4G5G6G7G8G13G14G15G16G17G18G19G20G24G25G26G27G28G29G30G31G35G36G37G38G39G40G41G42G45G46G47G48G49G50G51
8
9I1I2I3I4I5I6I7I8I11I12I13I14I15I16I17I18I21I22I23I26I27I28I29I30I31I32I33I36I37I38I39I40I41I42I43I46I47I48I49I50I51I52
10
Sheet1
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,541
Office Version
  1. 365
Platform
  1. Windows
Ok, how about
VBA Code:
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
 
Solution

methody

Well-known Member
Joined
Jun 17, 2002
Messages
845
It's not kicking in at all. Tried playing about with top row and first column but not getting anything
 

Watch MrExcel Video

Forum statistics

Threads
1,129,507
Messages
5,636,731
Members
416,937
Latest member
crispix

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