Replacement for the Flawed UsedRange Property

**snb** · 06-09-2012, 06:31 PM

Another approach ?

To retrieve a 'usedrange', containing numbers:

Code:

Sub snb_2_1()
    For Each ar In Cells.SpecialCells(2, 1).Areas
        If IsEmpty(c01) Then c01 = ar.Cells(1).Address
        c02 = Application.Max(c02, ar.Cells(ar.Cells.Count).Row)
        c03 = Application.Max(c03, ar.Cells(ar.Cells.Count).Column)
    Next
    MsgBox "UsedRange = " & Range(c01).Resize(c02 - Range(c01).Row + 1, c03 - Range(c01).Column + 1).Address
End Sub

To retrieve a 'usedrange', containing text:

Code:

Sub snb_2_2()
    For Each ar In Cells.SpecialCells(2, 2).Areas
        If IsEmpty(c01) Then c01 = ar.Cells(1).Address
        c02 = Application.Max(c02, ar.Cells(ar.Cells.Count).Row)
        c03 = Application.Max(c03, ar.Cells(ar.Cells.Count).Column)
    Next
    MsgBox "UsedRange = " & Range(c01).Resize(c02 - Range(c01).Row + 1, c03 - Range(c01).Column + 1).Address
End Sub

To retrieve a 'usedrange', containing constants:

Code:

Sub snb_2()
    For Each ar In Cells.SpecialCells(2, 2).Areas
        If IsEmpty(c01) Then c01 = ar.Cells(1).Address
        c02 = Application.Max(c02, ar.Cells(ar.Cells.Count).Row)
        c03 = Application.Max(c03, ar.Cells(ar.Cells.Count).Column)
    Next
    MsgBox "UsedRange = " & Range(c01).Resize(c02 - Range(c01).Row + 1, c03 - Range(c01).Column + 1).Address
End Sub

To retrieve a 'usedrange', containing formulae:

Code:

Sub snb_4123()
    For Each ar In Cells.SpecialCells(-4123).Areas
        If IsEmpty(c01) Then c01 = ar.Cells(1).Address
        c02 = Application.Max(c02, ar.Cells(ar.Cells.Count).Row)
        c03 = Application.Max(c03, ar.Cells(ar.Cells.Count).Column)
    Next
    MsgBox "UsedRange = " & Range(c01).Resize(c02 - Range(c01).Row + 1, c03 - Range(c01).Column + 1).Address
End Sub