Macro to return range when any included cell within that range has been selected.

[BNR]

Hello everyone,
I'd like to start by saying I have been using this forum for years and have always found not only the answers to my questions, but the community at large is willing to earnestly help.
Even with the more 'silly' requests, so I'd like to thank you, in advance for taking the time to read (and hopefully) respond with a solution.

In short, I'd like to pick a cell and know the following;

a) if the cell is already part of a merged group of cells
b) if the the cell IS part of an existing merged group, Id like that merged range returned (or at least the address of it)

The context here is I am displaying several grouped cells as a merged range on a worksheet. (its for staff shift times, say 10am ~ 1pm is represented as a collection of cells, the row is the same but columns are grouped to display a duration) From time to time, there may be overlapping ranges(say another 'shift' from 11am ~ 12pm), I'd like to detect and display when these overlaps occur but need to understand where the 'newest' range overlaps a previously rendered range.

something like;

public function CheckRange (RnG as range) as range

If RnG.MergeCells = true then
' if the RnG range is part of a larger range, I would like the parent range returned
set CheckRange = RnG.ParentRange

else
' if the RnG is a stand alone (not part of an existing merged range, then just return the original range)
set CheckRange = RnG

end if

end function

The worksheet I am writing does alot more than I have stated here, suffice to say the data is dynamically read in from a network location and displayed.
So while the format of the data is consistent, the overlapping shifts are never known until runtime.

Again, any help would be greatly appreciated.

Regards,
BenR

 

[Peter_SSs]

Welcome to the MrExcel board!

If I have understood correctly, then I think all you need is ..

Public Function CheckRange(RnG As Range) As Range
  Set CheckRange = RnG.MergeArea
End Function

 

[BNR]

Welcome to the MrExcel board!

If I have understood correctly, then I think all you need is ..

Public Function CheckRange(RnG As Range) As Range
  Set CheckRange = RnG.MergeArea
End Function

Peter,
Thank you for the prompt response.
I had a look at Range.MergeArea, but it only works for single cell ranges.

Range.MergeArea property (Excel)

Office VBA reference topic

docs.microsoft.com

I was also looking at something like

InRange = Not (Application.Intersect(Range1, Range2) Is Nothing)

But while this will tell me if there is an intersection, I need to find the address of the original range.

Example

public sub test()

dim sWS as worksheet
dim RnG1 as range
dim RnG2 as range
dm Test_RnG as range

set sWs = activesheet

'set 1st range with single row, but 10 columns - range is merged (to center displayed text)
set RnG1 = sws.range(sws.cells(1,1),sws.cells(1,10)) 

'set 2nd range with single row, but 2 columns
set RnG2 = sws.range(sws.cells(1,4),sws.cells(1,5))

' before I render 2nd range, I would like to test if RnG2 is contained within or overlaps an exiting range (in this example RnG1)
' this would allow me to render the subsequent overlaps differently and help identify anomalies in the source data
' Something like

set Test_RnG = Check_Overlap(Rng2)

' I would like the Check_Overlap function to return Rng1 as a range in this example

end sub

In the above example, both ranges are known at runtime, so its a trivial case.
But in my case, I am rendering a few thousand ranges (Its for a few hundred staff, over several weeks of timesheet data) so all ranges aren't known until runtime.

There is another way I *could* solve this, but it would involve rebuilding a different data structure to compare dates / times before rendering.
I'd prefer to not manipulate source data and just render what is presented.

I hope I have given sufficient detail.

regards,
BenR

 

[Peter_SSs]

Hopefully I have understood better this time - but maybe not?

Try this. Set up a fresh worksheet with these two merged ranges A1:J1 and D3:F3

Now with the code below, run the 'test' sub . It checks 3 ranges to see if each overlaps any merged area(s).

Sub test()
  Dim MA As Range
  Dim CR As Variant
  
  Const Check_Ranges As String = "D1:E1 D10:E10 E1:E4"
  
  For Each CR In Split(Check_Ranges)
    Set MA = Check_Overlap(Range(CR))
    If MA Is Nothing Then
      MsgBox "No overlap with merged ranges"
    Else
      MsgBox "Range " & CR & " overlaps with this/these merged range/s: " & vbLf & MA.Address(0, 0)
    End If
  Next CR
End Sub

Function Check_Overlap(RnG As Range) As Range
  Dim c As Range
  
  For Each c In RnG
    If c.MergeArea.Cells.Count > 1 Then
      If Check_Overlap Is Nothing Then
        Set Check_Overlap = c.MergeArea
      Else
        Set Check_Overlap = Union(Check_Overlap, c.MergeArea)
      End If
    End If
  Next c
End Function

If this is still not what you want, please give some specific examples of what you have and what you want, rather than any pseudo-code that doesn't quite do what you want.

 

[BNR]

Peter,

Thanks again for a prompt response.
At first glance this looks good.
I'll examine this solution and get back to you.

If this solves it (or if I can modify it to suit) I'll post back for all to see.

Otherwise I'll give a very specific code block to better describe the issue.
I have several large modules that handle multiple functions, rather than drop that on you I'll just strip out the best bits to properly define the problem.

Thanks again,
BenR

 

[BNR]

Peter,

I have tweaked your code a little to suit my specific need and it works perfectly - thank you.
For the benefit of others I have included a small description here.

1. The below code should be copied / pasted into a fresh workbook and module (for testing / understanding then just modify to suit your needs).
2. For this example, The activesheet should have the yellow cells merged as a single range for each row.
3. Run the test sub

The blue rows (in the picture) are only for visual indication of whats being compared, the actual range addresses are coded into the Check_Ranges string.

There are 9 cases I am testing for (as shown), I only offset the blue ranges one row lower to show how they would overlap column wise.
The 2 ranges that are compared may have different column address, but always the same row (hence a potential overlap).

Sub test()
  Dim MA As Range
  Dim CR As Variant
  Dim RnG As Range
  Dim Case_Num As Integer
    
  ' these define the blue ranges used for comparison, the yellow ranges should already be setup on the activesheet as merged ranges
  Const Check_Ranges As String = "C2:G2 C6:G6 C10:E10 E14:G14 C18:G18 C22:G22 C26:F26 D30:F30 D34:G34"

  For Each CR In Split(Check_Ranges)
    ' used to display which case is being tested
    Case_Num = Case_Num + 1
    
    Set RnG = ActiveSheet.Range(CR)
    Set MA = Check_Overlap(RnG)
    
    If MA Is Nothing Then
      MsgBox "No overlap with merged ranges", vbOKOnly, "Case " & Case_Num
    Else
      MsgBox "Yellow range " & MA.Address(0, 0) & " columns : " & MA.Columns.Count & Chr(10) & "Blue Range " & CR & " columns : " & RnG.Columns.Count, vbCritical, "Case " & Case_Num
    End If
    
  Next CR
  
End Sub

Function Check_Overlap(RnG As Range) As Range
  Dim c As Range
  
  For Each c In RnG
    If c.MergeArea.Cells.Count > 1 Then
      If Check_Overlap Is Nothing Then
        Set Check_Overlap = c.MergeArea
      Else
        Set Check_Overlap = Union(Check_Overlap, c.MergeArea)
      End If
    End If
  Next c
End Function

I'd like to add, Peter really did a wonderful job with this solution. Nice trick with the union function.
I haven't tested this for row AND column combinations, although I imagine it would work (or at most only require a small change)

Once again, thank you Peter.

regards,
BenR

 

[Peter_SSs]

You're welcome. Glad it helped. Thanks for the follow-up.