Overflow Error - Solving Temperature using Antoine Equation

I am trying to calculate the temperature for the hdrogentation column that has a pressure of 515 psia. When I enter this value I get "Overflow Error 6". I defined P as Long, but I still get the same error. I know the code will work if the pressure is changed to 55 psia. I believe the problem may be due to a very long mmHg value, because 515 psia = 26632 mmHg while 55 psi = 2844 mmHg. I have checked the Antoine coefficients and they are correct.

Here is my code. Please help. Attached file also.

Sub Mole()
Dim X(10), A(10), B(10), C(10), K(10), Y(10)
Dim P As Double


'Input Data
GoSub S1
Trial = 0
P1:
Trial = Trial + 1
Told = TNew
T = Told
'Calc FT and Deriv
GoSub S2
TNew = Told - FT / Deriv
T = TNew
'Calc FT
GoSub S2

If Abs(TNew - Told) <= 0.01 Then GoTo P2
GoTo P1
P2:
Range("H28").Value = T
End
'Input Data
S1:
X(1) = Sheets("Mole").Range("F24")
X(2) = Sheets("Mole").Range("F25")
A(1) = Sheets("Mole").Range("B4")
A(2) = Sheets("Mole").Range("B5")
B(1) = Sheets("Mole").Range("C4")
B(2) = Sheets("Mole").Range("C5")
C(1) = Sheets("Mole").Range("D4")
C(2) = Sheets("Mole").Range("D5")
P = (Sheets("Mole").Range("G28")) * 51.7149

TStart = 20
Told = 20
TNew = 20
Return
'Calc FT and Deriv
S2:
SumFT = 0
SumFPT = 0
For I = 1 To 2
K(I) = 10 ^ (A(I) - B(I) / (T + C(I))) / (P)
SumFT = SumFT + K(I) * X(I)
SumFPT = SumFPT + B(I) / ((T + C(I)) ^ 2) * K(I) * X(I)
Next I
FT = 1 - SumFT
Deriv = -Log(10) * SumFPT
Return
End Sub

I unwound your code a little:

Sub Mole()
    Dim X(1 To 2)   As Double
    Dim A(1 To 2)   As Double
    Dim B(1 To 2)   As Double
    Dim C(1 To 2)   As Double
    Dim K(1 To 2)   As Double
    Dim Y(1 To 2)   As Double
    Dim P           As Double

    Dim iTrial      As Long
    Dim t           As Double
    Dim tStart      As Double
    Dim tOld        As Double
    Dim tNew        As Double
    Dim Deriv       As Double
    Dim FT          As Double
    Dim SumFPT      As Double
    Dim sumFT       As Double

    Dim i           As Long

    'Input Data
    With Worksheets("Mole")
        X(1) = .Range("F24").Value
        X(2) = .Range("F25").Value
        A(1) = .Range("B4").Value
        A(2) = .Range("B5").Value
        B(1) = .Range("C4").Value
        B(2) = .Range("C5").Value
        C(1) = .Range("D4").Value
        C(2) = .Range("D5").Value
        P = .Range("G28").Value * 51.7149
    End With

    tStart = 20
    tNew = 20
    iTrial = 0

    Do
        iTrial = iTrial + 1
        tOld = tNew
        t = tOld

        'Calc FT and Deriv
        GoSub S2
        tNew = tOld - FT / Deriv
        t = tNew

        'Calc FT
        GoSub S2
    Loop Until Abs(tNew - tOld) <= 0.01

    Range("H28").Value = t
    Exit Sub

S2:
    'Calc FT and Deriv
    sumFT = 0
    SumFPT = 0

    For i = 1 To 2
        K(i) = 10 ^ (A(i) - B(i) / (t + C(i))) / P
        sumFT = sumFT + K(i) * X(i)
        SumFPT = SumFPT + B(i) / ((t + C(i)) ^ 2) * K(i) * X(i)
    Next i

    FT = 1 - sumFT
    Deriv = -Log(10) * SumFPT
    Return
End Sub

I suggest you step through it and see where the problem occurs. You might spend some time reading http://www.cpearson.com/excel/debug.htm