B
brettdj
Is there a way to peform the opposite of Intersect - ie remove a range
of cells (such as xlBlanks) from a parent range (such as the
Usedrange)
I've written a UDF below to do this but I'm wondering if there is a
more elegant approach
Regards
Dave
Sub SelectNonBlanks()
UsedRangeAddress(ActiveSheet.Name).Select
End Sub
Function UsedRangeAddress(ws) As Range
Dim myrange1 As Range
Dim myrange2 As Range
Dim myrange3 As Range
On Error GoTo error1
Set myrange1 = Intersect(Sheets(ws).UsedRange,
Sheets(ws).Cells.SpecialCells(xlFormulas))
On Error GoTo 0
On Error GoTo error2
Set myrange2 = Intersect(Sheets(ws).UsedRange,
Sheets(ws).Cells.SpecialCells(xlConstants))
On Error GoTo 0
If Not myrange1 Is Nothing And Not myrange2 Is Nothing Then
Set myrange3 = Union(myrange1, myrange2)
ElseIf Not myrange1 Is Nothing Then
Set myrange3 = myrange1
ElseIf Not myrange2 Is Nothing Then
Set myrange3 = myrange2
End If
Set UsedRangeAddress = myrange3
Exit Function
error1:
'no formulas
Set myrange1 = Nothing
Resume Next
error2:
'no constants
Set myrange2 = Nothing
Resume Next
End Function
of cells (such as xlBlanks) from a parent range (such as the
Usedrange)
I've written a UDF below to do this but I'm wondering if there is a
more elegant approach
Regards
Dave
Sub SelectNonBlanks()
UsedRangeAddress(ActiveSheet.Name).Select
End Sub
Function UsedRangeAddress(ws) As Range
Dim myrange1 As Range
Dim myrange2 As Range
Dim myrange3 As Range
On Error GoTo error1
Set myrange1 = Intersect(Sheets(ws).UsedRange,
Sheets(ws).Cells.SpecialCells(xlFormulas))
On Error GoTo 0
On Error GoTo error2
Set myrange2 = Intersect(Sheets(ws).UsedRange,
Sheets(ws).Cells.SpecialCells(xlConstants))
On Error GoTo 0
If Not myrange1 Is Nothing And Not myrange2 Is Nothing Then
Set myrange3 = Union(myrange1, myrange2)
ElseIf Not myrange1 Is Nothing Then
Set myrange3 = myrange1
ElseIf Not myrange2 Is Nothing Then
Set myrange3 = myrange2
End If
Set UsedRangeAddress = myrange3
Exit Function
error1:
'no formulas
Set myrange1 = Nothing
Resume Next
error2:
'no constants
Set myrange2 = Nothing
Resume Next
End Function