Solved: Multiple non consecutive cells selection

[angakis]

Hi,
I am trying to develop a simple module in order to select all the non empty cells in a given range. The script goes like this:

[VBA]Dim myrng(1500)
myrng(0) = ""
Set myrange = Range("A1:f10") 'a random range
col = myrange.Columns.Count
rws = myrange.Rows.Count
k = 0
n = -1
For i = 1 To rws
For j = 1 To col
If Cells(i, j).Value <> 0 Then
k = k + 1
n = n + 1
Cells(i, j).Activate
Cellz(k) = ActiveCell.Address
myrng(k) = myrng(n) & "Cellz(" & Str(k) & ")&"",""&"
End If
Next j
Next i
myrng(k) = Left(myrng(k), Len(myrng(k)) - 5)
rng = CStr(myrng(k))
Range(rng).Select
End Sub

[/VBA]
The vaule of rng is of the form cellz(1)&","&cellz(2)....&cellz(16)
I get the following error running this application

error:vba method range of object global failed

However, if instead i use directly:
rng=cellz(1)&","&cellz(2)...
this works fine.

I could really use some expert help on this since i am planning to use a similar provedure for a worksheet I use in my thesis.

Thanks in advance for any help

Kind Regards
Angelos

[Kenneth Hobs]

Welcome to the forum!

Please add vba code tags by pressing the VBA icon and paste your code between them.

We could do that if you really want to but I discourage use of Select. I would use something like this because I normally want to act or not act if the cell is empty or not.
[VBA]Sub test()
Dim myRange As Range, cell As Range
Set myRange = Range("A1:F10") 'a random range
For Each cell In myRange
If IsEmpty(cell) Then
Debug.Print cell.Address, "Empty"
Else: Debug.Print cell.Address, "Not Empty"
End If
Next cell
End Sub[/VBA]

The debug.print puts results in the VBE Immediate window.

[Aussiebear]

Could it be the typo "cellz" as against "cells"

[angakis]

I know the code was a bit messed up and I actually am going to simplify it a lot. However, my problem is not how to figure out which cells are empty, or how to address them but how to select them at the same time. Thus i ended up with this final part, using a string variable (rng) inside the Range function.
I really can't get why if define the variable as:
[VBA]rng=cellz(1)&","&cellz(2)...[/VBA]
then
[VBA]Range(rng).Select [/VBA]
works fine, whether inputing
[VBA]rng = CStr(myrng(k))
Range(rng).Select
[/VBA]
produces an error.

Thanks for your time

[mdmackillop]

[VBA]Sub NonBlanks()
Dim rng As Range
With ActiveSheet.UsedRange
Set rng = Union(.SpecialCells(xlCellTypeFormulas, 23), .SpecialCells(xlCellTypeConstants, 23))
End With
rng.Select
End Sub[/VBA]

[angakis]

Hmm tried this but get an error 1004, no cells were found.

[mdmackillop]

There must be a neater way!
[VBA]Sub NonBlanks()
Dim rng1 As Range
Dim rng2 As Range

On Error Resume Next
With ActiveSheet.UsedRange
Set rng1 = .SpecialCells(xlCellTypeFormulas, 23)
a = Err
Err.Clear
Set rng2 = .SpecialCells(xlCellTypeConstants, 23)
a = a + Err * 2
End With
Select Case a
Case 0
Union(rng1, rng2).Select
Case 1004
rng2.Select
Case 2008
rng1.Select
Case Else
MsgBox "No cells found"
End Select
End Sub
[/VBA]

[mdmackillop]

[VBA]Sub NonBlanks()
Dim rng1 As Range
Dim rng2 As Range

On Error Resume Next
With ActiveSheet.UsedRange
Set rng1 = .SpecialCells(xlCellTypeFormulas, 23)
Set rng2 = .SpecialCells(xlCellTypeConstants, 23)
End With
If Not rng1 Is Nothing Then
rng1.Select
If Not rng2 Is Nothing Then
Union(rng1, rng2).Select
End If
Else
rng2.Select
End If
End Sub[/VBA]

[Paul_Hossler]

I use a 'toolbox' function that returns as a range the results of .SpecialCells. I made it more general, but you could always simplify it if needed.

IMHO returning the Range in a function is a little more flexible since I can Set it into a variable to retain the cells, use Range properties by

ListSpecialCells( ...).Interior, etc.

As you can see by the Optional's, the most common thing I use it for is also to return the non-blanks cells in a range. Wonder why that's not a intrinisic option?


[vba]
'========================================================================== =====
'===================================================================== Special Cells
'========================================================================== =================
'XlCellType can be one of these XlCellType constants.
' -1 Non-blank cells, i.e. Formulas or Constants
' xlCellTypeAllFormatConditions Cells of any format
' xlCellTypeAllValidation Cells having validation criteria
' xlCellTypeBlanks Empty Cells
' xlCellTypeComments Cells containing notes
' xlCellTypeConstants Cells containing constants
' xlCellTypeFormulas Cells containing formulas
' xlCellTypeLastCell The last cell in the used range
' xlCellTypeSameFormatConditions Cells having the same format
' xlCellTypeSameValidation Cells having the same validation criteria
' xlCellTypeVisible All visible cells
'
' XlSpecialCellsValue if xlCellTypeConstants or xlCellTypeFormulas, used to determine which types
' of cells to include in the result. These values can be added together to return more than one
' type. The default is to select all constants or formulas, no matter what the type.
' xlErrors
' xlLogical
' xlNumbers
' xlTextValues
Function ListSpecialCells(r As Range, _
Optional CellTypes As Long = -1, _
Optional Special As Long = 0) As Range


Dim r1 As Range, r2 As Range, rC As Range, rF As Range
If r Is Nothing Then Exit Function

DoEvents

Set rC = Nothing
Set rF = Nothing

If CellTypes = -1 Then

On Error Resume Next
If Special = 0 Then
Set rC = r1.SpecialCells(xlCellTypeConstants)
Set rF = r1.SpecialCells(xlCellTypeFormulas)
Else
Set rC = r1.SpecialCells(xlCellTypeConstants, Special)
Set rF = r1.SpecialCells(xlCellTypeFormulas, Special)
End If
On Error GoTo 0

If rC Is Nothing And Not rF Is Nothing Then
Set ListSpecialCells = rF
ElseIf Not rC Is Nothing And rF Is Nothing Then
Set ListSpecialCells = rC
ElseIf Not rC Is Nothing And Not rF Is Nothing Then
Set ListSpecialCells = Union(rF, rC)
Else
Set ListSpecialCells = Nothing
Exit Function
End If

Else

Set r2 = Nothing
On Error Resume Next
If IsMissing(Special) Then
Set r2 = r1.SpecialCells(CellTypes)
ElseIf Special = 0 Then
Set r2 = r1.SpecialCells(CellTypes)
Else
Set r2 = r1.SpecialCells(CellTypes, Special)
End If
On Error GoTo 0

Set ListSpecialCells = r2
End If
End Function
[/vba]

Paul

[angakis]

Ok Thanks a lot for your replies!
Md they both worked fine, got it!

[mikerickson]

[VBA]Dim myRange As Range

With ActiveSheet.UsedRange
On Error Resume Next
Set myRange = .SpecialCells(xlCellTypeConstants)
Set myRange = .SpecialCells(xlCellTypeFormulas)
Set myRange = Application.Union(.SpecialCells(xlCellTypeConstants), myRange)
On Error GoTo 0
End With


If myRange Is Nothing Then
MsgBox "All cells are blank."
Else
MsgBox myRange.Address & " is the non-empty cells"
End If[/VBA]

[mdmackillop]

Thanks Mike,
Much neater.

[Kenneth Hobs]

Good idea working with SpecialCells guys. Using Mike's method as a function:
[vba]
Sub Test()
Dim aRange As Range
Set aRange = NonEmptyCells
If aRange Is Nothing Then
MsgBox "No empty cells."
Else: MsgBox "Non-Empty cells are: " & vbCrLf & aRange.Address
End If
End Sub

Function NonEmptyCells(Optional theSheetName As String) As Range
Dim myRange As Range
If theSheetName = "" Then theSheetName = ActiveSheet.Name
Set myRange = Worksheets(theSheetName).UsedRange
On Error Resume Next
Set NonEmptyCells = Application.Union(myRange.SpecialCells(xlCellTypeConstants), _
myRange.SpecialCells(xlCellTypeFormulas))
End Function[/vba]

[mdmackillop]

Hi Kenneth,
The Union fails unless both types of SpecialCells exist. See Posts 5 & 6

[Kenneth Hobs]

Thanks for checking that. In that case:
[VBA]Sub Test()
Dim aRange As Range
Set aRange = NonEmptyCells
If aRange Is Nothing Then
MsgBox "No empty cells found."
Else: MsgBox "Non-Empty cells are: " & vbCrLf & aRange.Address
End If
End Sub

Function NonEmptyCells(Optional theSheetName As String) As Range
Dim myRange As Range, r As Range, r2 As Range
On Error Resume Next
If theSheetName = "" Then theSheetName = ActiveSheet.Name
Set myRange = Worksheets(theSheetName).UsedRange
Set r = myRange.SpecialCells(xlCellTypeConstants)
Set r2 = myRange.SpecialCells(xlCellTypeFormulas)
Select Case True
Case Not r Is Nothing And Not r2 Is Nothing
Set NonEmptyCells = Application.Union(r, r2)
Case Not r Is Nothing
Set NonEmptyCells = r
Case Not r2 Is Nothing
Set NonEmptyCells = r2
End Select
End Function[/VBA]

[Benzadeus]

I just wrote in a different way...
[VBA]Sub NonBlanks()
Dim rng As Range, r1 As Range, r2 As Range

On Error Resume Next
Set r1 = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
Set r2 = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0

If Not r1 Is Nothing Then
If Not r2 Is Nothing Then
Set rng = Union(r1, r2)
Else
Set rng = r1
End If
Else
If Not r2 Is Nothing Then
Set rng = r2
Else
'rng is Nothing!
End If
End If

If Not rng Is Nothing Then rng.Select
End Sub[/VBA]

[mdmackillop]

Post 11 still neatest in my opinion.

[mikerickson]

Since the OP asked for "all the non empty cells in a given range"

Function NonEmptyCells(Optional givenRange As Range) as Range
    If givenRange Is Nothing Then Set givenRange = ActiveSheet.UsedRange
    With givenRange
        On Error Resume Next 
        Set NonEmptyCells = .SpecialCells(xlCellTypeConstants) 
        Set NonEmptyCells = .SpecialCells(xlCellTypeFormulas) 
        Set NonEmptyCells = Application.Union(.SpecialCells(xlCellTypeConstants), NonEmptyCells) 
        On Error Goto 0
    End With
End Function

[Benzadeus]

I hadn't notice... Mike's is better, really.

[Kenneth Hobs]

We might need a bit more tweaking to account for single cell ranges passed. The user should use IsEmpty() for this case but I can see times where a passed range could be single or multiple cell range.

The problem is that "$A$2" is shown in the 2nd MsgBox where we would expect to see the first MsgBox for this scenario.
e.g.
[VBA]Sub test()
Dim r As Range
Range("A2").Formula = "=1"
Range("A1").ClearContents
Set r = NonEmptyCells(Range("A1"))
If r Is Nothing Then
MsgBox "All cells are empty."
Else: MsgBox r.Address
End If
End Sub

Function NonEmptyCells(Optional givenRange As Range) As Range
If givenRange Is Nothing Then Set givenRange = ActiveSheet.UsedRange
With givenRange
On Error Resume Next
Set NonEmptyCells = .SpecialCells(xlCellTypeConstants)
Set NonEmptyCells = .SpecialCells(xlCellTypeFormulas)
Set NonEmptyCells = Application.Union(.SpecialCells(xlCellTypeConstants), NonEmptyCells)
On Error GoTo 0
End With
End Function[/VBA]