Seeking help with procedure – ranges vs arrays

[dsillers]

I’m working on an application that calculates the poverty rate (H) in each of a set of 80 countries based on each country’s average income (mu), three parameters (theta, gamma, and delta) that describe the distribution of income in that country, plus a fourth parameter – the poverty line, which in this case is common across countries. Finding H requires solving a non-linear equation, so I use the Newton-Raphson method to iterate to a solution.

For this purpose, I adapted a procedure found in a book to produce the following code. The good news is that it works. The bad news is that to use it, I have to copy the column of mu’s from the main sheet into a particular range on a separate sheet, run the procedure, and then copy the resulting column of H’s back to the main sheet. This is very cumbersome, because I have to re-do this calculation a lot as using different projections of mu and different poverty lines.

As you’ll see from the code, I have H defined as a range (a column). The procedure loops through each cell of range “H” and pulls in the corresponding values of the four parameters from four columns lined up in parallel to the “H” range, using Offset to tell the procedure where to look for the values of the parameters for that country. It then solves the equation for that country, then moves down to the next cell in “H” and repeats the process.

As I say, it works, but the current coding ties me down to the particular structure of that sheet. Is there a way I can re-write this code so that it can be more flexible? Ideally I’d like to replace the use of Offset with a way to reference the cells containing the appropriate parameter values that does not require that the columns containing those parameters be lined up a fixed number of columns to the left of “H.” To be clear, the four parameters don’t change, but I have 20 or so columns of projected income levels and would like to be able to calculate the implied value of H for each of the 80 countries.

I have the sense that I should be converting these ranges into arrays, but as a relative newbie in VBA, I don’t understand how to do that. But that’s just a guess – any other approach that works would be great! Many thanks in advance!

Here's the code:

Option Explicit


Public Sub Calc_Beta_H_2()


' Activate Sheet and First Cell.
    Worksheets("Calc_H_Beta").Activate
    Worksheets("Calc_H_Beta").Range("H").Font.Strikethrough = False
    Dim H As Range
    Dim Country As Range
    Dim theta As Range
    Dim gamma As Range
    Dim delta As Range
    Dim Correction As Double
' basic parameters
    Dim mu As Range
    Dim povline As Range
' components of Difference
    Dim f As Double
    Dim g As Double
    Dim k As Double
' first differences of f, g, and k
    Dim f_prime As Double
    Dim g_prime As Double
    Dim k_prime As Double
' counter
    Dim i As Long
  
' Level of accuracy required
    Const epsilon As Double = 0.0001
        
' Max number of iterations
    Const Nmax As Long = 1000
      
    Set H = Range("$H$4:$H$103")
    
' Temporarily remove protection from sheet
'    Worksheets("Calc_H_Beta").Unprotect Password:=""
    
' Loop
    For Each H In Range("$H$4:$H$17,$H$19:$H$34,$H$36:$H$83")
    Set povline = H.Offset(0, -5)
    Set mu = H.Offset(0, -4)
    Set theta = H.Offset(0, -3)
    Set gamma = H.Offset(0, -2)
    Set delta = H.Offset(0, -1)
    Set Country = H.Offset(0, -7)
       
    i = 0
    
' Loop
    Do While Abs(Difference(H, f, g, k, mu, povline)) > epsilon And i < Nmax
'      And H <> 0
        f = theta * H ^ gamma
        g = (1 - H) ^ delta
        k = (gamma / H - delta / (1 - H))
        f_prime = gamma * theta * H ^ (gamma - 1)
        g_prime = -delta * (1 - H) ^ (delta - 1)
        k_prime = -((gamma / (H ^ 2)) + (delta / (1 - H) ^ 2))
        
        Correction = Difference(H, f, g, k, mu, povline) / Diff_prime(H, f, g, k, f_prime, g_prime, k_prime)
        H = H - Correction
    On Error Resume Next
        i = i + 1
    
' If initial calculation pushes H above 100% or below 0%, reset the guesses close to but within those boundaries
        If H >= 1 Then H = 0.999999
                
        If H <= 0 Then H = 0.000001
               
' End loop
    Loop
    
' Report value if successful
   If Abs(Difference(H, f, g, k, mu, povline)) < epsilon Then
        H.Value = H
' Otherwise report lack of convergence
    Else
        MsgBox ("No convergence after " & Str(i) & " iterations - try new initial value." & vbNewLine & (Country))
        On Error Resume Next
    End If
    
' End Loop
Next
    
' Re-Apply Protection to sheet
'    Worksheets("Calc_H_Beta").Protect
    
    
End Sub
Private Function Difference(H As Range, ByVal f As Double, ByVal g As Double, ByVal k As Double, ByVal mu As Double, ByVal povline As Double) As Double
    On Error Resume Next
      Difference = f * g * k - 1 + povline / mu
    
           End Function
           
Private Function Diff_prime(H As Range, ByVal f As Double, ByVal g As Double, ByVal k As Double, _
        ByVal f_prime As Double, ByVal g_prime As Double, ByVal k_prime As Double) As Double
    Diff_prime = f_prime * g * k + g_prime * f * k + k_prime * f * g
    On Error Resume Next
End Function