better approach to this loop? works, but looks inelegant - excel

Question

I have a large table of data with multiple columns that contain data for mostly triplicates of results. each row contains results from one data point for each subject. most of the subjects have three replicate results, but in some cases, there is only one or two. the sheet is sorted on the subject id column (which is my named range assigned to the variable rng used in the for loop).
this loop tests whether "targetcell" in the range "rng" (which is set to the named range in the sheet that contains the subject id), find the bottom row of any subjects duplicate or triplicate values, and then generates the mean in the newly inserted column:
Set rng = Range("clonesptid")
col = ActiveCell.Column
ActiveCell.Offset(0, 1).EntireColumn.Insert
anchor = col - rng.Column
'MsgBox "cell to test is " & rng(1)
'debugging message box to check where the ptid range is
'MsgBox "Range for ptID is " & rng.Column & " and the active cell address is " & ActiveCell.Address & " and the activecell col is " & anchor
For Each cell In rng
'uncomment the line below to check the cell addresses
' str = str & Cell.Address & " contains " & Cell.Value & "(above=" & Cell.Offset(-1, 0).Value & " below=" & Cell.Offset(1, 0).Value & vbNewLine
' MsgBox "What is our test value?" & vbNewLine & cell.Value
If IsEmpty(cell.Value) = True Then Exit For
targetcell = cell.Value
If cell.Row > 2 Then twoup = cell.Offset(-2, 0).Value
If cell.Row > 1 Then oneup = cell.Offset(-1, 0).Value
onedown = cell.Offset(1, 0).Value
If IsEmpty(targetcell) = False Then
If cell.Row = 1 Then
'adds title with means to first header row
Cells(1, col + 1).Value = Cells(1, col).Value & " mean"
ElseIf cell.Row = 2 And targetcell <> oneup And targetcell <> onedown Then
'test the first value, if unique mean = the value of the cell
cell.Offset(0, anchor + 1).Value = cell.Offset(0, anchor).Value
ElseIf targetcell <> oneup And targetcell <> onedown Then
'for all the rest of the cells in the range, this condition tests for singlets
cell.Offset(0, anchor + 1).Value = cell.Offset(0, anchor).Value
ElseIf targetcell = oneup And targetcell <> twoup And targetcell <> onedown Then
'test for two values
cell.Offset(0, anchor + 1).Value = (cell.Offset(0, anchor).Value + cell.Offset(-1, anchor).Value) / 2
ElseIf targetcell = oneup And targetcell = twoup And targetcell <> onedown Then
'test for three values
cell.Offset(0, anchor + 1).Value = (cell.Offset(0, anchor).Value + cell.Offset(-1, anchor).Value + cell.Offset(-2, anchor).Value) / 3
Else
'this is the first or second replicate of duplicates or triplicates, but not yet the bottom value
cell.Offset(0, anchor + 1).Value = ""
End If
End If
Next

Answer 1

If you have a specific operation like "find all same values up and down" then it's best to move that to a separate method.
Untested:
Sub tester()
Dim rng As Range, cell As Range, dups As Range
Dim lastDup As Range, col As Long, anchor As Long
col = ActiveCell.Column
Cells(1, col + 1).EntireColumn.Insert
Cells(1, col + 1).Value = "Mean"
Set rng = Range("clonesptid")
anchor = col - rng.Column
Set cell = rng.Cells(1)
Do While Len(cell.Value) > 0
Set dups = DupsRange(cell) 'get contiguous range with same value in column
Set lastDup = dups.Cells(dups.Cells.Count)
'calculate your average here
lastDup.Offset(0, anchor + 1) = Application.Average(dups.Offset(0, anchor))
Set cell = lastDup.Offset(1, 0) 'next set
Loop
End Sub
'Given a cell, check up and down to find
' the contiguous same-value range
Public Function DupsRange(c As Range) As Range
Dim cStart As Range, cEnd As Range
If Len(c.Value) = 0 Then Exit Function
Set cStart = c
Set cEnd = c
Do While cStart.Row > 1
If cStart.Offset(-1, 0).Value = c.Value Then _
Set cStart = cStart.Offset(-1, 0) Else Exit Do
Loop
Do While cEnd.Row < Rows.Count
If cEnd.Offset(1, 0).Value = c.Value Then _
Set cEnd = cEnd.Offset(1, 0) Else Exit Do
Loop
Set DupsRange = c.Parent.Range(cStart, cEnd)
End Function