Option Explicit
Sub CMA()
    '
    ' illustrate the logic used to perform a CMA sample
    ' Cumulative Monetary Amount (CMA) sampling
    '
    ' J represents the materiality amount, e.g. 5% of the population value
    ' R represents the required precision 1=highest 2=medium 3=low
    ' From these values, the interval is computed as J / R
    '
    ' The population is separated into three portions:
    '    1.  Credit transactions (not subject to sampling)
    '    2.  Debits larger than interval are sampled 100%
    '    3.  Debits less than the interval are sampled proportionately to size
    '
    ' Program logic narrative is as follows:
    ' Initialize all counters and balance accumulators to zero
    ' Compute the interval as J / R
    ' Use a starting random number between 0 and negative interval value
    ' Read a transaction at a time, performing the following actions:
    '
    ' 1.  all transactions - update counters of number of debits and credits
    '                      - update accumulator balances debit and credit
    ' 2.  for credit transactions, no further processing
    ' 3.  debit transactions will either be equal to or greater than interval
    '                        or lese less than
    ' 3a. if greater or equal, select the transaction, update accumualtors
    ' 3b. if less than, add the transaction amount to running subtotal
    '      if the addition makes it go positive, then select and subtract
    '      the interval amount
    '      update selection counters and accumulators
    '
    ' 4.  at end of file, report the total statistics and print
    '      a sample reconciliation report
    '      the reconciliation report compares to the population debits
    '      to the sample amounts over and under the interval and
    '      adjusts for the starting and ending random numbers
    '
    '  The code below implements this logic in Microsoft Visual Basic for
    '    Applications
    '  EZ-R Stats for Windows uses the same logic, but written in the C++
    '    programming language
    Dim c As Object
    Dim rn As Double
    Dim R As Integer
    Dim J As Integer
    Dim Itvl As Double
    Dim numdr As Integer
    Dim numcr As Integer
    Dim amtdr As Double
    Dim amtcr As Double
    Dim sMsg As String
    Dim d As Double
    Dim rnstart As Double
    Dim rnend As Double
    Dim underJ As Long
    Dim overJ As Long
    Dim AmtUnderJ As Double
    Dim AmtOverJ As Double
    Dim numsel As Long
    Dim s As Object
    Dim RecNo As Long
    
    Set c = Sheets("CMA").Range("b2")
    Set s = Sheets("Selections").Range("a2")
    numdr = 0  ' initialize all values to zero
    numcr = 0
    amtdr = 0
    amtcr = 0
    underJ = 0
    overJ = 0
    AmtUnderJ = 0
    AmtOverJ = 0
    numsel = 0
    RecNo = 0
    R = 2      ' arbitrarily set r to 2 - s/b 1,2 or 3
    J = 50     ' specify the J value selected
    Itvl = J / R
    rn = -Rnd(0) * (Itvl)   ' begin with a random number between 0 and interval
    rnstart = rn
    sMsg = "R is " & R & vbCrLf
    sMsg = sMsg & "J is " & J & vbCrLf
    sMsg = sMsg & "Interval (J/R) is " & Itvl & vbCrLf
    sMsg = sMsg & "Random start is " & rn & vbCrLf
    'MsgBox sMsg
    Do While Len(c.Value) > 0
       d = c.Value
       RecNo = RecNo + 1
       ' update population statistics
       If d < 0 Then
          amtcr = amtcr + d
          numcr = numcr + 1
       Else
          amtdr = amtdr + d
          numdr = numdr + 1
          If d < Itvl Then
             underJ = underJ + 1
             AmtUnderJ = AmtUnderJ + d
          Else
             overJ = overJ + 1
             AmtOverJ = AmtOverJ + d
          End If
       End If
       ' CMA sampling logic follows
       If d > 0 Then        ' logic applies only to dr
          rn = rn + d
          If d >= Itvl Then ' over J, just select it
             rn = rn - d
             s.Value = RecNo   ' write the selection another sheet
             s.Offset(0, 1).Value = d
             s.Offset(0, 2).Value = rn
             Set s = s.Offset(1, 0)
          Else
             If rn > 0 Then  ' otherwise, only select if > 0
                rn = rn - Itvl
                numsel = numsel + 1
                s.Value = RecNo  ' write the selection to another sheet
                s.Offset(0, 1).Value = d
                s.Offset(0, 2).Value = rn
                Set s = s.Offset(1, 0)
             End If
          End If
       End If
       
       Set c = c.Offset(1, 0)
    Loop
    rnend = rn
    sMsg = sMsg & "Number of dr " & numdr & " Amount " & amtdr & vbCrLf
    sMsg = sMsg & "Number of cr " & numcr & " Amount " & amtcr & vbCrLf
    sMsg = sMsg & "Number under J " & underJ & " Amount " & AmtUnderJ & vbCrLf
    sMsg = sMsg & "Number over J " & overJ & " Amount " & AmtOverJ & vbCrLf
    sMsg = sMsg & "Start rn " & rnstart & " End rn " & rnend & vbCrLf
    sMsg = sMsg & "num sel " & numsel & " Amount " & numsel * Itvl & vbCrLf
    d = numsel * Itvl
    d = d + AmtOverJ
    d = d + rnend - rnstart
    sMsg = sMsg & "Computed DR " & d & " Pop dr " & amtdr & vbCrLf
    sMsg = sMsg & "Diff " & d - amtdr & vbCrLf
    MsgBox sMsg
       
End Sub