Relative Humidity Calculator Routine

Use this shorty program to compute relative humidity from dry bulb air temperature and dew point. Potential workflow and reason for usage would be something like this: Have hourly air temperature & relative humidity data... would like to compute mean daily or mean monthly values for RH but you can't apply a simple average to RH. So... 1) Use the dew point calculator program to compute dew point from hourly time series of AT & RH 2) Use the calculate mean daily or mean monthly subroutine to find mean air temperature and dew point 3) Use this subroutine to calculate RH from air temperature and dew point.

Sub RH_Calcs()

'' This subroutine runs through a worksheet and calculates relative humidity from dew point and air temperature
'' as per the Dingman book appendix.

    Dim inputrow As Long
    Dim outputrow As Long
    Dim inputdatecol As Integer
    Dim inputtempcol As Integer
    Dim inputdpcol As Integer
    Dim outputrhcol As Integer
    Dim inputWS As Integer
    Dim outputWS As Integer
    Dim es As Double
    Dim temperature As Double
    Dim Wa As Double
    Dim e As Double
    Dim dewpoint As Double
    
    inputdatecol = 1
    inputWS = 1
    inputrow = 15
    outputWS = inputWS
    outputrow = inputrow
    
    inputdpcol = 14
    inputtempcol = 15
    outputrhcol = 16
    
    
    Do While Worksheets(inputWS).Cells(inputrow, inputdatecol).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 And _
                Worksheets(inputWS).Cells(inputrow, inputtempcol).Value <> "" Then
            temperature = Worksheets(inputWS).Cells(inputrow, inputtempcol).Value
        Else:
          temperature = 6999
        End If
        If Abs(Worksheets(inputWS).Cells(inputrow, inputdpcol).Value) <> 6999 And _
                Abs(Worksheets(inputWS).Cells(inputrow, inputdpcol).Value) <> 7777 And _
                Abs(Worksheets(inputWS).Cells(inputrow, inputdpcol).Value) <> 9999 And _
                Abs(Worksheets(inputWS).Cells(inputrow, inputdpcol).Value) <> 9999.9 And _
                Worksheets(inputWS).Cells(inputrow, inputdpcol).Value <> "" Then
            dewpoint = Worksheets(inputWS).Cells(inputrow, inputdpcol).Value
        Else:
            dewpoint = 6999
        End If
        If temperature <> 6999 And dewpoint <> 6999 Then
            es = 0.611 * Exp((17.3 * temperature) / (temperature + 237.3))
            e = 0.611 * Exp((17.3 * dewpoint) / (dewpoint + 237.3))
            Wa = e / es * 100
        Else:
            Wa = 6999
        End If
        If Wa <> 6999 Then
            Worksheets(outputWS).Cells(outputrow, outputrhcol).Value = Wa
        End If
        outputrow = outputrow + 1
        inputrow = inputrow + 1
    Loop
    Range("A12").Select
End Sub