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 WorksheetFunction s 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