patternMinor
Wrapper for complicated Range manipulation
Viewed 0 times
rangewrappermanipulationforcomplicated
Problem
I'm playing around with a class module to try to wrap up some complicated(ish) Range manipulation in Excel-VBA.
I might have a situation where I know the red range spans my target (the target is to have it's contents cleared) and all cells below the red range should go. Green areas are cells used that should not be deleted:
Another example: I only know the red cell - and all used cells just to it's right and below it are to be cleared. Again all green cells should be left alone:
Usually the above is done via manipulation by finding extreme cells (
Class Module Name:
```
Private fCurrentRange As Excel.Range
''::
''::
Public Enum expandDirection
toTheRight = 1
fromTheRight = 2
downwards = 3
fromSheetBase = 4
End Enum
'':: read/write property - initial range
''::
Public Property Let CurrentRange(ByRef rng As Excel.Range)
Set fCurrentRange = rng
End Property
Public Property Get CurrentRange() As Excel.Range
Set CurrentRange = fCurrentRange
End Property
':: Expand
':: this will need to use an enumerated type as options
'::
Public Sub expand(ByVal aDir As expandDirection)
Dim lstCell As Excel.Range
Dim lstRow As Long
Dim lstCol As Long
Set lstCell = Me.CurrentRange.Cells(Me.CurrentRange.Cells.Count)
lstRow = Me.CurrentRange.Cells(Me.CurrentRange.Cells.Count).Row
lstCol = Me.CurrentRange.Cells(Me.CurrentRange.Cells.Count).Column
If (aDir = downwards) Then
Dim newLstRow As Long
'newLstRow = lstCell.End(Excel.xlDown).Row
newLstRow = Me.CurrentRange.CurrentRegion.Cells(Me.CurrentRange.CurrentRegion.Cells.Count).Row
Me.CurrentRange = _
Range( _
Me.CurrentRange.Cells(1), _
Me.CurrentRange.Worksheet.Cells( _
newLstRow, _
lstCol _
) _
)
End If
If (aDir = toTheRight) Then
Dim newLstCol
I might have a situation where I know the red range spans my target (the target is to have it's contents cleared) and all cells below the red range should go. Green areas are cells used that should not be deleted:
Another example: I only know the red cell - and all used cells just to it's right and below it are to be cleared. Again all green cells should be left alone:
Usually the above is done via manipulation by finding extreme cells (
rows.count...toLeft etc) or the CurrentRegion property of Range. I've attempted to wrap that functionality into a Class Module:Class Module Name:
TargetRange```
Private fCurrentRange As Excel.Range
''::
''::
Public Enum expandDirection
toTheRight = 1
fromTheRight = 2
downwards = 3
fromSheetBase = 4
End Enum
'':: read/write property - initial range
''::
Public Property Let CurrentRange(ByRef rng As Excel.Range)
Set fCurrentRange = rng
End Property
Public Property Get CurrentRange() As Excel.Range
Set CurrentRange = fCurrentRange
End Property
':: Expand
':: this will need to use an enumerated type as options
'::
Public Sub expand(ByVal aDir As expandDirection)
Dim lstCell As Excel.Range
Dim lstRow As Long
Dim lstCol As Long
Set lstCell = Me.CurrentRange.Cells(Me.CurrentRange.Cells.Count)
lstRow = Me.CurrentRange.Cells(Me.CurrentRange.Cells.Count).Row
lstCol = Me.CurrentRange.Cells(Me.CurrentRange.Cells.Count).Column
If (aDir = downwards) Then
Dim newLstRow As Long
'newLstRow = lstCell.End(Excel.xlDown).Row
newLstRow = Me.CurrentRange.CurrentRegion.Cells(Me.CurrentRange.CurrentRegion.Cells.Count).Row
Me.CurrentRange = _
Range( _
Me.CurrentRange.Cells(1), _
Me.CurrentRange.Worksheet.Cells( _
newLstRow, _
lstCol _
) _
)
End If
If (aDir = toTheRight) Then
Dim newLstCol
Solution
Using your method, I would opt for a
That way you don't have to check every
Then all you need to do is pass a range and a string to
Also, as I mentioned in the comments, I'm not sure
You can double check it, I'm on 2007 and just used
So anything that's a connection to the cell you've chosen, will be part of the
So your first picture the
As to how to fix this - I'm not sure. Maybe ask for the input to be the "header" row, but that only works if you want to clear all the way down. It defeats the whole purpose of this. I didn't mean to point out a problem and not provide a solution - sorry.
Select Case when determining which way to go.Sub expand(ByVal rangeToExpand As Range, ByVal whatDirection As String)
Dim lastRow As Long
Dim lastColumn As Long
Select Case whatDirection
whatDirection = "toTheRight"
lastRow = rangeToExpand.CurrentRegion.Row
lastColumn = Cells(rangeToExpand.Row, rangeToExpand.CurrentRegion.Column.Count).End(xlToRight).Column
Set rangeToExpand = Range(rangeToExpand, Cells(lastRow, lastColumn))
whatDirection = "fromTheRight"
lastRow = rangeToExpand.CurrentRegion.Row
lastColumn = Cells(rangeToExpand.Row, rangeToExpand.CurrentRegion.Column.Count).End(xlToLeft).Column
Set rangeToExpand = Range(rangeToExpand, Cells(lastRow, lastColumn))
whatDirection = "downwards"
lastColumn = rangeToExpand.CurrentRegion.Column
lastRow = Cells(rangeToExpand.CurrentRegion.Rows.Count, rangeToExpand.Column).End(xlUp).Row
Set rangeToExpand = Range(rangeToExpand, Cells(lastRow, lastColumn))
whatDirection = "fromSheetBase"
lastColumn = rangeToExpand.CurrentRegion.Column
lastRow = Cells(rangeToExpand.CurrentRegion.Rows.Count, rangeToExpand.Column).End(xlDown).Row
Set rangeToExpand = Range(rangeToExpand, Cells(lastRow, lastColumn))
End Select
rangeToExpand.ClearContents
End SubThat way you don't have to check every
if every time. If my method is off for the directions, I probably misunderstood the goal of each string, but I don't see them in the original.Then all you need to do is pass a range and a string to
expand and it does all the work. Or make expand a function and pass the range back to the caller.Also, as I mentioned in the comments, I'm not sure
.CurrentRegion is the way to go. If working with A1 in here - these are the CurrentRegions -You can double check it, I'm on 2007 and just used
Sub testing()
Dim rng As Range
Set rng = Range("A1")
rng.CurrentRegion.Select
End SubSo anything that's a connection to the cell you've chosen, will be part of the
CurrentRegion - even if it's all snakey like that.So your first picture the
CurrentRegion = D5:G40 and the second picture CurrentRegion = D4:L40 assuming the red cell(s) is the selection.As to how to fix this - I'm not sure. Maybe ask for the input to be the "header" row, but that only works if you want to clear all the way down. It defeats the whole purpose of this. I didn't mean to point out a problem and not provide a solution - sorry.
Code Snippets
Sub expand(ByVal rangeToExpand As Range, ByVal whatDirection As String)
Dim lastRow As Long
Dim lastColumn As Long
Select Case whatDirection
whatDirection = "toTheRight"
lastRow = rangeToExpand.CurrentRegion.Row
lastColumn = Cells(rangeToExpand.Row, rangeToExpand.CurrentRegion.Column.Count).End(xlToRight).Column
Set rangeToExpand = Range(rangeToExpand, Cells(lastRow, lastColumn))
whatDirection = "fromTheRight"
lastRow = rangeToExpand.CurrentRegion.Row
lastColumn = Cells(rangeToExpand.Row, rangeToExpand.CurrentRegion.Column.Count).End(xlToLeft).Column
Set rangeToExpand = Range(rangeToExpand, Cells(lastRow, lastColumn))
whatDirection = "downwards"
lastColumn = rangeToExpand.CurrentRegion.Column
lastRow = Cells(rangeToExpand.CurrentRegion.Rows.Count, rangeToExpand.Column).End(xlUp).Row
Set rangeToExpand = Range(rangeToExpand, Cells(lastRow, lastColumn))
whatDirection = "fromSheetBase"
lastColumn = rangeToExpand.CurrentRegion.Column
lastRow = Cells(rangeToExpand.CurrentRegion.Rows.Count, rangeToExpand.Column).End(xlDown).Row
Set rangeToExpand = Range(rangeToExpand, Cells(lastRow, lastColumn))
End Select
rangeToExpand.ClearContents
End SubSub testing()
Dim rng As Range
Set rng = Range("A1")
rng.CurrentRegion.Select
End SubContext
StackExchange Code Review Q#121079, answer score: 2
Revisions (0)
No revisions yet.