ExcelBanter - Problem with too large a range

That's perfect. Thank you very much.

"Jim Thomlinson" wrote:

Give this a whirl...

Sub HighlightUpperLeftTriangle2()
Dim lngCounter As Long
Dim rngUpperLeft As Range
Dim rngSelection As Range
Dim rng As Range

Set rngSelection = Selection
With rngSelection
If .Rows.Count < .Columns.Count Then
MsgBox ("You have not selected an equal number of rows as columns. "
& _
"Please go back and make sure they are the same and re-run.")
Exit Sub
ElseIf .Rows.Count = 1 Or .Rows.Count = 1 Then
MsgBox ("You have either select just one row, one column or one " & _
"cell please select a square range and re-run")
Exit Sub
End If
lngCounter = .Rows.Count
End With
Set rngSelection = rngSelection.Columns(1)
For Each rng In rngSelection.Cells
If rngUpperLeft Is Nothing Then
Set rngUpperLeft = rng.Resize(, lngCounter)
Else
Set rngUpperLeft = Union(rngUpperLeft, rng.Resize(, lngCounter))
End If
lngCounter = lngCounter - 1
Next rng
rngUpperLeft.Select
End Sub
--
HTH...

Jim Thomlinson

"fullers" wrote:

I have the macro below that is run after a user highlights a square block of
data (25 rows by 25 columns for example) and it then selects those cells that
form the upper left triangle within the square.

The problem I am having is if more than about 35 rows/columns are
highlighted I get an error message. I believe I would need to modify my code
to include the Union() command but not sure how to do this.

Any help would be most appreciated.

Sub HighlightUpperLeftTriangle()

Dim FirstRow, FirstColumn, RowCount, ColumnCount, LastRow, LastColumn, x As
Long
Dim RangeSelect As String

Application.ScreenUpdating = False

FirstRow = Selection(1).Row
FirstColumn = Selection(1).Column
LastRow = FirstRow + Selection.Rows.Count - 1
LastColumn = FirstColumn + Selection.Columns.Count - 1
RowCount = Selection.Rows.Count
ColumnCount = Selection.Columns.Count

If RowCount < ColumnCount Then
MsgBox ("You have not selected an equal number of rows as columns.
Please go back and make sure they are the same and re-run.")
Exit Sub
Else
If RowCount = 1 Or ColumnCount = 1 Then
MsgBox ("You have either select just one row, one column or one cell
please select a square range and re-run")
Exit Sub
End If
End If

RangeSelection = Range(Cells(FirstRow, FirstColumn), Cells(LastRow,
FirstColumn)).Address(False, False)

For x = 1 To RowCount - 1
RangeSelection = RangeSelection & "," & Range(Cells(FirstRow,
FirstColumn + x), Cells(LastRow - x, FirstColumn + x)).Address(False, False)
Next x

Range(RangeSelection).Select

End Sub