Finding subrange combination totals from main range

chuckjitsu

New Member
Joined
Apr 24, 2015
Messages
48
Office Version
  1. 365
  2. 2016
Hello again. Here's what I'm looking at today. There's a 10x10 range, A1:J10. Within that range, there are 120 subranges of 5 cells each (A1:E1, A1:A5, etc.) that are just vertical/horizontal (no diagonals) and don't extend beyond row 10 or column J. Also within that same 10x10 range, there are 140 subranges of 4 cells each (A1:D1, A1:A4, etc.) that also are just vertical/horizontal (no diagonals) and don't extend beyond row 10 or column J. What I'm trying to find is the total number of non overlapping/intersecting 5 cell and 4 cell combinations in the main 10x10 range. So for example, A1:A5 and B2:E2 would be one valid combination whereas A1:E1 and B1:B4 would not be due to the intersection at B1.

The total number of combinations is 16,800 (120x140), but those include overlapping/intersecting ranges, which are combinations I don't want to include in the total count of 5 and 4 cell range combinations. I'm leaning toward a VBA solution, but I'm open to a worksheet solution if one of the wizards around here can figure that one out! Per usual, thanks in advance.
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
A brute force approach:

VBA Code:
Sub CountIntersections()

    Set d1 = CreateObject("Scripting.Dictionary")
    Set d2 = CreateObject("Scripting.Dictionary")
    
    For r = 1 To 10
        For c = 1 To 6
            d1(d1.Count + 1) = Cells(1, 1).Cells(r, c).Resize(, 5).Address
        Next c
    Next r
    
    For c = 1 To 10
        For r = 1 To 6
            d1(d1.Count + 1) = Cells(1, 1).Cells(r, c).Resize(5).Address
        Next r
    Next c
    
    For r = 1 To 10
        For c = 1 To 7
            d2(d2.Count + 1) = Cells(1, 1).Cells(r, c).Resize(, 4).Address
        Next c
    Next r
    
    For c = 1 To 10
        For r = 1 To 7
            d2(d2.Count + 1) = Cells(1, 1).Cells(r, c).Resize(4).Address
        Next r
    Next c

    For Each x1 In d1
        For Each x2 In d2
            If Intersect(Range(d1(x1)), Range(d2(x2))) Is Nothing Then ctr = ctr + 1
        Next x2
    Next x1
    
    Debug.Print d1.Count, d2.Count, ctr
End Sub
 
Upvote 0
Solution
A brute force approach:

VBA Code:
Sub CountIntersections()

    Set d1 = CreateObject("Scripting.Dictionary")
    Set d2 = CreateObject("Scripting.Dictionary")
   
    For r = 1 To 10
        For c = 1 To 6
            d1(d1.Count + 1) = Cells(1, 1).Cells(r, c).Resize(, 5).Address
        Next c
    Next r
   
    For c = 1 To 10
        For r = 1 To 6
            d1(d1.Count + 1) = Cells(1, 1).Cells(r, c).Resize(5).Address
        Next r
    Next c
   
    For r = 1 To 10
        For c = 1 To 7
            d2(d2.Count + 1) = Cells(1, 1).Cells(r, c).Resize(, 4).Address
        Next c
    Next r
   
    For c = 1 To 10
        For r = 1 To 7
            d2(d2.Count + 1) = Cells(1, 1).Cells(r, c).Resize(4).Address
        Next r
    Next c

    For Each x1 In d1
        For Each x2 In d2
            If Intersect(Range(d1(x1)), Range(d2(x2))) Is Nothing Then ctr = ctr + 1
        Next x2
    Next x1
   
    Debug.Print d1.Count, d2.Count, ctr
End Sub
Hi Eric. Thanks for the response. I'll mark my question as answered. Do you see a way to do this that's not brute force? I ask because the problem I presented was a scaled down version of the original problem, which had more subranges of different sizes. The potential combinations for the subranges runs in to the tens of billions. Not here, but a guy posted a Python based solution to this problem and stated that the code only took minutes to find a solution. I'm not familiar with Python, so I took his claim at face value, but that is impressive if true because our brute force method isn't anywhere close to that speed wise.

This thread went unanswered for a bit, so I took a serious stab at it thinking nobody might post a solution/suggestion. My solution is pretty much what you came up with, except I used Collections instead of Dictionaries. I don't know if it's possible for VBA to come up with a solution that takes minutes to find a solution instead of hours, but if it was possible, I figured one of the pros around here would know how.
 
Upvote 0
If it's possible to do in Python, it's possible to do in VBA. VBA is Turing Complete after all. The big issue is finding the right algorithm. Although I don't know for sure, this problem has all the hallmarks of a "tricky" type of problem. One where there is a simple, brute force, slow way, or another way that's faster but harder to find. Computer science has tons of problems like this, like how to find the fastest, cheapest way to traverse a lattice. If you can find the right search terms, it's probably on the internet somewhere.

There's a web site call Project Euler that does exactly this. It poses problems that have a simple, easy algorithm that would take about a billion years to solve, or a clever solution that takes under a minute. I used to do a lot of those until it got to be more work than fun.

Anyway, on this particular website, most questions are basic Excel usage questions, not how to construct a clever algorithm. There are a few here who might be up to the task, but I doubt even they would take on such a challenge unless they already had the code in their personal libraries.

So good luck!
 
Upvote 0
If it's possible to do in Python, it's possible to do in VBA. VBA is Turing Complete after all. The big issue is finding the right algorithm. Although I don't know for sure, this problem has all the hallmarks of a "tricky" type of problem. One where there is a simple, brute force, slow way, or another way that's faster but harder to find. Computer science has tons of problems like this, like how to find the fastest, cheapest way to traverse a lattice. If you can find the right search terms, it's probably on the internet somewhere.

There's a web site call Project Euler that does exactly this. It poses problems that have a simple, easy algorithm that would take about a billion years to solve, or a clever solution that takes under a minute. I used to do a lot of those until it got to be more work than fun.

Anyway, on this particular website, most questions are basic Excel usage questions, not how to construct a clever algorithm. There are a few here who might be up to the task, but I doubt even they would take on such a challenge unless they already had the code in their personal libraries.

So good luck!
I figured some sort of formula or algorithm would be the answer, I just don't have enough skill in that area to come up with it on my own. I looked at Python guy's code to at least see if I could figure out a way to transfer the concepts to VBA, but I couldn't get it going and didn't put a ton of time in to it.

My VBA solution to the original problem worked, but when I saw that Python guy's solution worked in minutes instead of hours, I felt there had to be a way to do it that fast in VBA, but it sounds like a challenge even for an experienced VBA code writer. I think I'm going to raise the white flag on this one for now, but thanks for your help.
 
Upvote 0

Forum statistics

Threads
1,215,051
Messages
6,122,871
Members
449,097
Latest member
dbomb1414

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
Back
Top