PDA

View Full Version : Solved: Multiple non consecutive cells selection



angakis
12-17-2008, 12:44 PM
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:

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


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
12-17-2008, 01:51 PM
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.
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

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

Aussiebear
12-17-2008, 03:02 PM
Could it be the typo "cellz" as against "cells"

angakis
12-17-2008, 03:02 PM
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:
rng=cellz(1)&","&cellz(2)...
then
Range(rng).Select
works fine, whether inputing
rng = CStr(myrng(k))
Range(rng).Select

produces an error.

Thanks for your time

mdmackillop
12-17-2008, 03:30 PM
Sub NonBlanks()
Dim rng As Range
With ActiveSheet.UsedRange
Set rng = Union(.SpecialCells(xlCellTypeFormulas, 23), .SpecialCells(xlCellTypeConstants, 23))
End With
rng.Select
End Sub

angakis
12-17-2008, 03:54 PM
Hmm tried this but get an error 1004, no cells were found.

mdmackillop
12-17-2008, 04:36 PM
There must be a neater way!
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

mdmackillop
12-17-2008, 04:57 PM
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

Paul_Hossler
12-17-2008, 05:44 PM
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? :dunno



'========================================================================== =====
'===================================================================== 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


Paul

angakis
12-17-2008, 09:33 PM
Ok Thanks a lot for your replies!
Md they both worked fine, got it!

mikerickson
12-17-2008, 10:39 PM
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

mdmackillop
12-18-2008, 06:14 AM
Thanks Mike,
Much neater.

Kenneth Hobs
12-18-2008, 06:43 AM
Good idea working with SpecialCells guys. Using Mike's method as a function:

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

mdmackillop
12-18-2008, 06:50 AM
Hi Kenneth,
The Union fails unless both types of SpecialCells exist. See Posts 5 & 6

Kenneth Hobs
12-18-2008, 07:21 AM
Thanks for checking that. In that case:
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

Benzadeus
12-18-2008, 09:32 AM
I just wrote in a different way...
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

mdmackillop
12-18-2008, 10:04 AM
Post 11 still neatest in my opinion.

mikerickson
12-18-2008, 11:43 AM
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
12-18-2008, 12:03 PM
I hadn't notice... Mike's is better, really.

Kenneth Hobs
12-18-2008, 08:45 PM
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.
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

mikerickson
12-18-2008, 09:10 PM
Good eye. It appears that a singleCell.SpecialCells returns the appropriate cells in the whole UsedRange.
This should account for that bug.

Function NonEmptyCells(Optional givenRange As Range) As Range
If givenRange Is Nothing Then Set givenRange = ActiveSheet.UsedRange
With givenRange.Parent.UsedRange
With Application.Union(givenRange, .Cells(1, .Columns.Count + 1))
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 With
End Function

angakis
12-19-2008, 08:38 AM
Ok, you ve been more than helpful.

However, any clues why the one I tried did not work. I am especially wondering about the part:
rng = CStr(myrng(k))
Range(rng).Select

When i use
Range(rng)
where rng is defined as a string which you can actually print.debug and see that it produces
cellz(1)&","&cellz(2)....&cellz(16)
i get an error but when i directly define
rng=cellz(1)&","&cellz(2)....&cellz(16)
(
then it works perfectly.

angakis
12-21-2008, 10:31 AM
Hi there i post these two codes

Private Sub Select_NonEmpty_Cells()
Dim rng As String
Dim fin As String
Dim cellz(1500)
Dim myrng(1500)
myrng(0) = ""
Set myRange = Range("A1:W1000")
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(k) & ","
End If
Next j
Next i
myrng(k) = Left(myrng(k), Len(myrng(k)) - 1)
rng = CStr(myrng(k))
'the point is that in order for the range to work one of the followin forms must be used
'range("a1"&","&"a2"...) or range("a1,a2,b3") or range(rng) where rng produces a1,a2,b3
Debug.Print (myrng(k))
Range(myrng(k)).Select
End Sub



Private Sub Select_Multiple_Columns()
Dim SpCol, Nocol
Dim Strtc(1000)
Dim Stcol
'input of parameters starts
Stcol = Application.InputBox(prompt:="Which is the First Column?" & vbCrLf & "(e.g. A)", Title:="First Column", Type:=2)
If Not (Stcol Like "[A-Z]" Or Stcol Like "[a-z]") Then 'Check for validity of input
Do
Stcol = Application.InputBox(prompt:="Input the First Column as CHARACTER?" & vbCrLf & "(e.g. A)", Title:="CAUTION !!!", Type:=2)
Loop Until Stcol Like "[A-Z]" Or Stcol Like "[a-z]"
End If
Nocol = Application.InputBox(prompt:="Give the number of Columns to select?", Title:="Number of Columns", Type:=1)
SpCol = Application.InputBox(prompt:="Give the Spacing Between Columns?", Title:="Column Spacing", Type:=1)
'end of parameter input
On Error Resume Next
Stx = CStr(Stcol) & ":" & CStr(Stcol) 'stx is a string-like range variable
Strtc(0) = Stx
Set f = Range(Stx)
l = 0
For j = 1 To Nocol - 1
l = l + 1
g = SpCol + 1
e = f.Offset(o, g).Address 'moves to the next column by space g
Strtc(j) = Strtc(j - 1) & "," & e ' strtc constructs by loop the string to be set as a range
Set f = Range(e)
Next j
Set r = Range(Strtc(l))
Range(Strtc(l)).Select
End Sub


The first one selects all the non empty cells in a sheet using a not so common routine, but very useful in my understanding, whereas the second one can be used to select columns with a spacing.

Both work fine up to a point but i recently discovered a limitation: when the number of non empty cellz in the first case or the number of columns selected by the user in the second, exceed a certain number i.e. the value of myrng(k) and Strtc(l) becomes large (they're both string like in the form of $a$1,$a$3,$b$1....) the program produces an error.
Does anyone know of a way to overcome this without changing the code? (i know it could be simpler or using unions and specialcells) I guess its just a problem defining these arrays.

Kenneth Hobs
12-21-2008, 11:13 AM
See: http://vbaexpress.com/forum/showthread.php?t=24310

angakis
12-21-2008, 01:38 PM
See: http://vbaexpress.com/forum/showthread.php?t=24310
Yep, I know thats my thread as well but this is not answered there either. I guess there is a length limitation for this variable which I can't overcome thus I should proceed in another way.

Thanks anywayz

lucas
12-21-2008, 01:55 PM
Threads merged

GTO
12-22-2008, 05:17 PM
Both work fine up to a point but i recently discovered a limitation: when the number of non empty cellz in the first case or the number of columns selected by the user in the second, exceed a certain number i.e. the value of myrng(k) and Strtc(l) becomes large (they're both string like in the form of $a$1,$a$3,$b$1....) the program produces an error.
Does anyone know of a way to overcome this without changing the code? (i know it could be simpler or using unions and specialcells) I guess its just a problem defining these arrays.


Yep, I know thats my thread as well but this is not answered there either. I guess there is a length limitation for this variable which I can't overcome thus I should proceed in another way.

Thanks anywayz

Greetings,

As you already received great help from some very knowledgeable folks, I didn't read through all. That said, it appears your last question is at building a string, wherein said string later defines a range. If this is the case, I don't believe you can surpass the 255 character limitation.

Hope that helps,

Mark

angakis
12-23-2008, 05:02 AM
Yep Mark, that helps indeed. I tried to solve this bug using a conditional select case loop, checking the length of the string and assigning the rest of the string to a new variable in case it exceeds 240 characters, or spliting (using split) the string in an array. It seems i can extend my codes which become more comlpex and thus i ll use a function instead. Thanks for all the help guys.

mikerickson
12-23-2008, 08:49 PM
Using Range variables instead of strings will prevent special handling for long range addresses.