DewPoint Calculator Routine
Jump to navigation
Jump to search
This shorty calculates dew point from dry bulb air temperature and relative humidity so daily / monthly averages can be computed.
Sub DewPoint_Calcs()
'' This subroutine runs through a worksheet and calculates dewpoint from relative humidity and air temperature
'' as per the Dingman book appendix.
Dim inputrow As Long
Dim outputrow As Long
Dim inputtempcol As Integer
Dim inputrhcol As Integer
Dim outputdpcol As Integer
Dim inputWS As Integer
Dim outputWS As Integer
Dim eastar As Double
Dim temperature As Double
Dim Wa As Double
Dim ea As Double
Dim dewpoint As Double
inputWS = 1
inputrow = 4
inputtempcol = 5
inputrhcol = 8
outputWS = inputWS
outputrow = inputrow
outputdpcol = 15
Do While Worksheets(inputWS).Cells(inputrow, inputtempcol).Value <> ""
'' #1 Read in the values
If Abs(Worksheets(inputWS).Cells(inputrow, inputtempcol).Value) <> 6999 And _
Abs(Worksheets(inputWS).Cells(inputrow, inputtempcol).Value) <> 7777 And _
Abs(Worksheets(inputWS).Cells(inputrow, inputtempcol).Value) <> 9999 And _
Abs(Worksheets(inputWS).Cells(inputrow, inputtempcol).Value) <> 9999.9 Then
temperature = Worksheets(inputWS).Cells(inputrow, inputtempcol).Value
Else:
temperature = 6999
End If
If Abs(Worksheets(inputWS).Cells(inputrow, inputrhcol).Value) <> 6999 And _
Abs(Worksheets(inputWS).Cells(inputrow, inputrhcol).Value) <> 7777 And _
Abs(Worksheets(inputWS).Cells(inputrow, inputrhcol).Value) <> 9999 And _
Abs(Worksheets(inputWS).Cells(inputrow, inputrhcol).Value) <> 9999.9 Then
Wa = Worksheets(inputWS).Cells(inputrow, inputrhcol).Value
Else:
Wa = 6999
End If
If temperature <> 6999 And Wa <> 6999 Then
eastar = 0.611 * (Exp((17.3 * temperature) / (temperature + 237.3)))
ea = eastar * Wa / 100
dewpoint = (Log(ea) + 0.4926) / (0.0708 - 0.00421 * Log(ea))
Else:
dewpoint = 6999
End If
Worksheets(outputWS).Cells(outputrow, outputdpcol).Value = dewpoint
outputrow = outputrow + 1
inputrow = inputrow + 1
Loop
Range("A12").Select
End Sub