Range and ActiveCell.Offset Run-time error '1004'

Question

I'm trying to determine the minimum and maximum values of a 5 cell range (C:G) for all non-blank rows in a worksheet and place the respective results in columns L and M.

I'm getting a Run-time error '1004' Application-defined or object-defined error.

Sub test()
    ActiveSheet.Range("A1").Select
    ActiveCell.Offset(1, 0).Select
    Do While ActiveCell.Value <> Empty
        ActiveCell.Offset(0, 11) = WorksheetFunction.Min(Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 6)))
        ActiveCell.Offset(0, 12) = WorksheetFunction.Max(Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 6)))
        ActiveCell.Offset(1, 0).Select
    Loop
    ActiveSheet.Range("A1").Select
End Sub

I'm pretty sure my problem is in the specification of the range but not sure what it is.

The first and last selects are just a convention I use.

The second select is to step past a header row.

The third select is to increment the row.

If there is a simpler way to do this, please let me know.

Answer 1

I can't reproduce the error you mention, your code seems to run as is.

That said there a many ways to improve this code

1. Avoid Select (as mentioned in comments)
2. The Application object offers Min and Max functions, no need to use WorksheetFunctions for these
3. Better approach to range references is a combination of Offset and Resize

Your code, refactored to used these techniques

Sub Demo()
    Dim ws As Worksheet
    Dim rng As Range
    Dim rw As Range

    ' Get a reference to the source data range
    Set ws = ActiveSheet
    With ws
        Set rng = .Cells(2, 1)
        ' Just in case there is only one data row
        If Not IsEmpty(rng.Offset(1, 0)) Then
            Set rng = .Range(rng, rng.End(xlDown))
        End If
    End With

    ' Loop the range
    For Each rw In rng.Rows
        rw.Offset(0, 11) = Application.Min(rw.Offset(0, 1).Resize(, 5))
        rw.Offset(0, 12) = Application.Max(rw.Offset(0, 1).Resize(, 5))
    Next
End Sub

That said, you can go further and use a Variant Array approach. This runs much faster than looping a range (impact will vary depending on number of data rows)

Sub Demo2()
    Dim ws As Worksheet
    Dim rng As Range
    Dim dat As Variant
    Dim res As Variant
    Dim i As Long

    ' Get a reference to the source data range
    Set ws = ActiveSheet
    With ws
        Set rng = .Cells(2, 1)
        ' Just in case there is only one data row
        If Not IsEmpty(rng.Offset(1, 0)) Then
            Set rng = .Range(rng, rng.End(xlDown))
        End If
    End With

    ' Set up source and result arrays
    dat = rng.Offset(, 2).Resize(, 5).Value
    ReDim res(1 To UBound(dat, 1), 1 To 2)

    With Application
        ' Loop the array
        For i = 1 To UBound(dat, 1)
            res(i, 1) = .Min(.Index(dat, i))
            res(i, 2) = .Max(.Index(dat, i))
        Next
    End With

    ' Return results to sheet
    rng.Offset(0, 11).Resize(, 2) = res
End Sub

Another technique is to avoid a loop entirely by (temporarily) placing formula into the sheet in one go. This will be much faster still (for more than a few data rows)

Sub Demo3()
    Dim ws As Worksheet
    Dim rng As Range
    Dim rw As Range

    ' Get a reference to the source data range
    Set ws = ActiveSheet
    With ws
        Set rng = .Cells(2, 1)
        If Not IsEmpty(rng.Offset(1, 0)) Then
            Set rng = .Range(rng, rng.End(xlDown))
        End If
    End With

    ' Place formulas into sheet
    rng.Offset(0, 11).FormulaR1C1 = "=Min(RC[-9]:RC[-5])"
    rng.Offset(0, 12).FormulaR1C1 = "=Max(RC[-9]:RC[-5])"

    ' replace formulas with values (optional)
    rng.Value = rng.Value
End Sub

Answer 2

How about this?

Sub MinAndMax()
    Dim rng As Range
    Set rng = Range("A2:A" & Range("A2").End(xlDown).Row)

    Range("L1") = WorksheetFunction.Min(rng)
    Range("M1") = WorksheetFunction.Max(rng)
End Sub

• Define the range upfront
• Write the min and max to the cells directly