How move calculations 5 rows over until no values to calculate?

[ggilzow]

Sub DR1()
Dim FR As Double
Dim Density As Double
Dim Id As Double
Dim m As Double
Dim length As Double
Dim PDC As Double
Dim PDM As Double
Dim Cff As Double
Dim ReN As Double
Dim pi As Double
Dim V As Double
Dim DR As Double
Dim pvOffset As Integer

pi = 3.14159265

'Set FR = Range("A6")
pvOffset = 6

FR = Cells(pvOffset, 1)
Do Until FR = 0
Density = Cells(pvOffset, 3)
PDM = Cells(pvOffset, 4)
Id = Range("b2")
m = Range("b4")
length = Range("d2")
V = 0.00222800926 * FR / (pi * (Id / 12) ^ 2) * 4
ReN = 928 * V * Id * Density / m
Cff = (0.3164 / ReN ^ 0.25)
PDC = Cff * V ^ 2 * Density * length / (25.8 * Id) / 4
DR = (-PDM + PDC) / PDC * 100
Cells(pvOffset, 5).Value = DR
pvOffset = pvOffset + 1
FR = Cells(pvOffset, 1)
Loop

End Sub

I am trying to figure out how to move the calculation 5 columns to the right after it has finished calculating the first set of calculations. Then stop calculating if there are no values to calculate on the new set of data.