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