Not tested
You can simplify your loops a little, and (if I understood the question) use something like the <<<<<<<<<<< line to return values to the worksheet
Sub Looper()
Dim iSetups As Long
Dim dStartElev As Double
Dim dMaxMisc As Double
Dim dBS() As Double
Dim dHI() As Double
Dim dFS() As Double
Dim dElev() As Double
Dim dCorr() As Double
Dim dAdjElev() As Double
Dim i As Integer
Dim Rows As Integer
Dim dRodSumBS As Double
Dim dRodSumFS As Double
Dim dMisclosure As Double
iSetups = Cells(5, 2)
dStartElev = Cells(6, 2)
dMaxMisc = Cells(7, 2)
dRodSumBS = 0
dRodSumFS = 0
ReDim dBS(1 To iSetups)
ReDim dHI(1 To iSetups)
ReDim dFS(1 To iSetups)
ReDim dElev(1 To iSetups + 1)
ReDim dCorr(1 To iSetups + 1)
ReDim dAdjElev(1 To iSetups + 1)
For i = LBound(dBS) To UBound(dBS)
dBS(i) = 11 + Cells(2 * (i - 1), 2)
Next I
For i = LBound(dFS) To UBound(dFS)
dFS(i) = 13 + Cells(2 * (i - 1), 2)
Next I
dElev(1) = dStartElev
For i = LBound(dHI) To UBound(dHI)
dHI(i) = dElev(i) + dBS(i)
dElev(i + 1) = dHI(i) - dFS(i)
Next I
For i = LBound(dBS) To UBound(dBS)
dRodSumBS = dBS(i) + dRodSumBS
dRodSumFS = dFS(i) + dRodSumFS
Next I
dMisclosure = Round(dRodSumBS - dRodSumFS, 2)
For i = LBound(dCorr) To UBound(dCorr)
dCorr(i) = Round((dMisclosure / iSetups) * (i - 1), 2)
dAdjElev(i) = dElev(i) - dCorr(i)
Next I
Cells(28, 2).Value = dRodSumBS ' <<<<<<<<<<<<<<<<<<
End Sub