Store special cells in one range

[YasserKhalil]

Hello everyone
I have range("A1:B16") with some data and blank cells ..
If both cells are empty in both columns so to skip those cells ..
But if one of those cells are empty and the other are not empty, then to store the empty cell in a range ..

I need solution without loops if possible ..
Here's a snapshot (the yellow cells should be stored in one range)

Untitled.jpg

[mana]

I don't understand. What does "store the empty cell" mean?

[YasserKhalil]

I simply need to deal with those yellow cells as one range ...

[Paul_Hossler]

There's only one yellow cell


If I'm understanding the question ....


Capture.JPG

Option Explicit
Sub Guess()
    Dim r As Range, r1 As Range, r2 As Range, r3 As Range
    
    Set r = Range("A1:B16")
    Set r1 = r.Columns(1).SpecialCells(xlCellTypeConstants)
    Set r2 = r.Columns(2).SpecialCells(xlCellTypeConstants)
    
    MsgBox r.Address
    MsgBox r1.Address
    MsgBox r2.Address
    
    Set r3 = Intersect(r1.EntireRow, r2.EntireRow)
    MsgBox r3.Address
    
    'or all on one big long line
    MsgBox Intersect(Range("A1:B16").Columns(1).SpecialCells(xlCellTypeConstants).EntireRow, Range("A1:B16").Columns(2).SpecialCells(xlCellTypeConstants).EntireRow).Address

End Sub

or just the A:B columns

Capture1.JPG

Option Explicit
Sub Guess()
    Dim r As Range, r1 As Range, r2 As Range, r3 As Range
    
    Set r = Range("A1:B16")
    Set r1 = r.Columns(1).SpecialCells(xlCellTypeConstants)
    Set r2 = r.Columns(2).SpecialCells(xlCellTypeConstants)
    
    MsgBox r.Address
    MsgBox r1.Address
    MsgBox r2.Address
    
    Set r3 = Intersect(r1.EntireRow, r2.EntireRow)
    MsgBox r3.Address
    
    'or all on one big long line
    MsgBox Intersect(Range("A1:B16").Columns(1).SpecialCells(xlCellTypeConstants).EntireRow, Range("A1:B16").Columns(2).SpecialCells(xlCellTypeConstants).EntireRow).Address

    'or all on one big long line with just the 2 columns
    MsgBox Intersect(Range("A1:B16"), Range("A1:B16").Columns(1).SpecialCells(xlCellTypeConstants).EntireRow, Range("A1:B16").Columns(2).SpecialCells(xlCellTypeConstants).EntireRow).Address
 

End Sub

[YasserKhalil]

Thanks a lot Mr. Paul
I am sorry for confusion .. But yellow cells are not just one cell (I have selected the yellow cells before taking a snapshot so it appears as if there is only one cell)
The desired cells that are needed to be stored in one range : A1 - B8 - B9 - B15

I tried something like that but got an error

Sub Test()
    Dim rng As Range
    
    Set rng = Range("A1:B16").SpecialCells(xlCellTypeConstants).SpecialCells(xlCellTypeBlanks)
    
    MsgBox rng.Address
End Sub

[mdmackillop]

Function BlankCells() As Range
    Dim r As Range
    Set r = ActiveSheet.UsedRange.Resize(, 3)
    Rows("1:1").Insert
    With r.Columns(3)
        .FormulaR1C1 = "=COUNTA(RC[-2]:RC[-1])"
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:="1"
        Set BlankCells = r.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeBlanks)
        BlankCells.Interior.ColorIndex = 5
        .AutoFilter
        .ClearContents
     End With
     Rows("1:1").Delete
End Function

[YasserKhalil]

That's great Mr. MD
Exactly as needed but is there a decent approach to achieve that ..

[mdmackillop]

Exactly as needed but is there a decent approach to achieve that ..

I consider a working solution to be "decent"

[p45cal]

Try:

Sub blah()
Dim ResultRange As Range, ColumnRanges(1 To 2) As Range
With Range("A1:B16")
  'Union(Intersect(.Columns(1).SpecialCells(xlCellTypeBlanks), .Columns(2).SpecialCells(xlCellTypeConstants, 23).Offset(, -1)), Intersect(.Columns(2).SpecialCells(xlCellTypeBlanks), .Columns(1).SpecialCells(xlCellTypeConstants, 23).Offset(, 1))).Select ''will do it in one shot IF there are eligible cells in BOTH columns.
  On Error Resume Next
  Set ColumnRanges(1) = .Columns(1).SpecialCells(xlCellTypeBlanks).Offset(, 1).SpecialCells(xlCellTypeConstants, 23).Offset(, -1)
  Set ColumnRanges(2) = .Columns(2).SpecialCells(xlCellTypeBlanks).Offset(, -1).SpecialCells(xlCellTypeConstants, 23).Offset(, 1)
  On Error GoTo 0
End With
For Each ColumnRange In ColumnRanges 'this loop thru 2 columns is much easier than a bunch of IF..Then..Else statements.
  If Not ColumnRange Is Nothing Then If ResultRange Is Nothing Then Set ResultRange = ColumnRange Else Set ResultRange = Union(ResultRange, ColumnRange)
Next ColumnRange
If Not ResultRange Is Nothing Then ResultRange.Select Else MsgBox "Nothing to select"
End Sub

[YasserKhalil]

Thanks a lot Mr. P45cal for this great solution
Thank you very much for all of you for these wonderful solutions
Best Regards

[mdmackillop]

I need solution without loops if possible ..

Turncoat!

[YasserKhalil]

Thanks .. At first I didn't know what 'Turncoat' means so I searched google to know the translation !!
As for P45Cal and your solution, I didn't notice any loops and that is desired for me ..

[p45cal]

As for P45Cal and your solution, I didn't notice any loops and that is desired for me ..

This is a loop:

For Each ColumnRange In ColumnRanges
        If Not ColumnRange Is Nothing Then If ResultRange Is Nothing Then Set ResultRange = ColumnRange Else Set ResultRange = Union(ResultRange, ColumnRange) 
Next ColumnRange

which can, in fact, be 'un-looped' (it's actually longer) to:

If Not ColumnRanges(1) Is Nothing Then If ResultRange Is Nothing Then Set ResultRange = ColumnRanges(1) Else Set ResultRange = Union(ResultRange, ColumnRanges(1)) 
If Not ColumnRanges(2) Is Nothing Then If ResultRange Is Nothing Then Set ResultRange = ColumnRanges(2) Else Set ResultRange = Union(ResultRange, ColumnRanges(2))

[mdmackillop]

If Not ColumnRanges(1) Is Nothing Then If ResultRange Is Nothing Then Set ResultRange = ColumnRanges(1) Else Set ResultRange = Union(ResultRange, ColumnRanges(1))

[YasserKhalil]

I really didn't notice loops at first ..
But the last post is working well without loops
Thank you very much for great contributions