Gord Dibben wrote...
....
Or use this UDF in combination with a macro.
Function RangeToUse(anySheet As Worksheet) As Range
Dim i As Integer, C As Integer, R As Integer
With anySheet.UsedRange
i = .Cells(.Cells.Count).Column + 1
For C = i To 1 Step -1
If Application.CountA(anySheet.Columns(C)) > 0 Then Exit For
Next
i = .Cells(.Cells.Count).Row + 1
For R = i To 1 Step -1
If Application.CountA(anySheet.Rows(R)) > 0 Then Exit For
Next
End With
With anySheet
Set RangeToUse = .Range(.Cells(1, 1), .Cells(R, C))
End With
End Function
....
Repeatedly calling COUNTA on worksheet ranges isn't a recipe for nimble
VBA procedures. Also, if the goal were locating the last row with
nonblank cells, there's no reason to reduce the number of columns.
Finally, this might be useful as a UDF, so generalize it.
Function bmr(Optional x As Variant) As Long
Dim ur As Range, r As Range
If IsMissing(x) Then
Set ur = ActiveSheet.UsedRange
ElseIf TypeOf x Is Worksheet Then
Set ur = x.UsedRange
ElseIf TypeOf x Is Range Then
Set ur = x.Worksheet.UsedRange
Else
On Error Resume Next
bmr = -1 'return -1 for invalid args
Set ur = Evaluate(x).Worksheet.UsedRange
If Err.Number <> 0 Then Exit Function
On Error GoTo 0
End If
Set r = ur.Cells(ur.Cells.Count)
Do While r.Row > 1 And r.Formula = "" And r.End(xlToLeft).Formula =
""
Set r = r.Offset(-1, 0)
Loop
'return 0 if used range is A1 only and A1 is blank
If r.Row > 1 Or r.Formula <> "" Or r.End(xlToLeft).Formula <> "" Then
_
bmr = r.Row
End Function
And similarly for the rightmost column.
Function rmc(Optional x As Variant) As Long
Dim ur As Range, r As Range
If IsMissing(x) Then
Set ur = ActiveSheet.UsedRange
ElseIf TypeOf x Is Worksheet Then
Set ur = x.UsedRange
ElseIf TypeOf x Is Range Then
Set ur = x.Worksheet.UsedRange
Else
On Error Resume Next
rmc = -1 'return -1 for invalid args
Set ur = Evaluate(x).Worksheet.UsedRange
If Err.Number <> 0 Then Exit Function
On Error GoTo 0
End If
Set r = ur.Cells(ur.Cells.Count)
Do While r.Column > 1 And r.Formula = "" And r.End(xlUp).Formula = ""
Set r = r.Offset(0, -1)
Loop
'return 0 if used range is A1 only and A1 is blank
If r.Column > 1 Or r.Formula <> "" Or r.End(xlUp).Formula <> "" Then
_
rmc = r.Column
End Function
And generate the range from A1 to the last cell in which there's a
nonblank cell in the same row and column using the previous functions.
Function nbr(Optional x As Variant) As Range
Dim ws As Worksheet
Dim r As Long, c As Long
If IsMissing(x) Then
Set ws = ActiveSheet
ElseIf TypeOf x Is Worksheet Then
Set ws = x
ElseIf TypeOf x Is Range Then
Set ws = x.Worksheet
Else
On Error Resume Next
'return Nothing for invalid args
Set ws = Evaluate(x).Worksheet
If Err.Number <> 0 Then Exit Function
On Error GoTo 0
End If
r = bmr(ws)
c = rmc(ws)
If r > 0 And c > 0 Then
Set nbr = ws.Range("A1").Resize(r, c)
Else
Set nbr = ws.Range("A1")
End If
End Function
