PDA

View Full Version : [SOLVED] Store special cells in one range



YasserKhalil
07-31-2017, 06:43 AM
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)

19948

mana
07-31-2017, 07:21 AM
I don't understand. What does "store the empty cell" mean?

YasserKhalil
07-31-2017, 07:23 AM
I simply need to deal with those yellow cells as one range ...

Paul_Hossler
07-31-2017, 07:35 AM
There's only one yellow cell


If I'm understanding the question ....


19949






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

19951





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
07-31-2017, 07:49 AM
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
07-31-2017, 07:53 AM
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
07-31-2017, 07:59 AM
That's great Mr. MD
Exactly as needed but is there a decent approach to achieve that ..

mdmackillop
07-31-2017, 08:04 AM
Exactly as needed but is there a decent approach to achieve that ..
I consider a working solution to be "decent"

p45cal
07-31-2017, 08:10 AM
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
07-31-2017, 08:41 AM
Thanks a lot Mr. P45cal for this great solution
Thank you very much for all of you for these wonderful solutions
Best Regards

mdmackillop
07-31-2017, 08:47 AM
I need solution without loops if possible ..
Turncoat!

YasserKhalil
07-31-2017, 09:46 AM
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
07-31-2017, 09:58 AM
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 ColumnRangewhich 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
07-31-2017, 10:16 AM
If Not ColumnRanges(1) Is Nothing Then If ResultRange Is Nothing Then Set ResultRange = ColumnRanges(1) Else Set ResultRange = Union(ResultRange, ColumnRanges(1))
:clap2:

YasserKhalil
07-31-2017, 10:56 AM
I really didn't notice loops at first ..
But the last post is working well without loops
Thank you very much for great contributions