Help modifying macro - accounting analysis

[Shultzie]

I have the macro shown below, which I found in a 2003 issue of the journal of accountancy - and it works great. However, it only works on a data set that begins in cell A1. I want to incorporate it into a spreadsheet I have where my data set begins in cell E15 and goes down from there(column E will be the only column that this macro will need to run on and I need it to work on a data set that will vary in length). This macro performs a Benford analysis, which analyzes the first and second number of a data set. <?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>

Dim Arrayone(0 To 9) As Integer
Dim Arraytwo(0 To 9) As Integer
Dim Arraythree(0 To 9) As Integer
Dim Arrayfour(0 To 9) As Integer
Dim Arrayfive(0 To 9) As Integer
Dim Arraysix(0 To 9) As Integer
Dim Arrayseven(0 To 9) As Integer
Dim Arrayeight(0 To 9) As Integer
Dim Arraynine(0 To 9) As Integer
Dim Arrayzero(0 To 9) As Integer
Dim Arraytwotest(10 To 99) As Integer

Dim x, I

Dim Row As Long, Col As Long, Step As Long, Colcells

Dim Digits As Long, Total As Long

Col = Application.CountA(ActiveSheet.Range("1:1"))

For Step = 1 To Col
Cells(1, Step).Select
Selection.End(xlDown).Select
Row = ActiveCell.Row
For Colcells = 1 To Row

x = Left(Cells(Colcells, Step), 2)
If x > 9 Then
Arraytwotest(x) = Arraytwotest(x) + 1
End If


For Digits = 1 To Len(Cells(Colcells, Step))

Select Case Mid(Cells(Colcells, Step), Digits, 1)
Case 1
Arrayone(Digits) = Arrayone(Digits) + 1

Case 2
Arraytwo(Digits) = Arraytwo(Digits) + 1

Case 3
Arraythree(Digits) = Arraythree(Digits) + 1

Case 4
Arrayfour(Digits) = Arrayfour(Digits) + 1

Case 5
Arrayfive(Digits) = Arrayfive(Digits) + 1

Case 6
Arraysix(Digits) = Arraysix(Digits) + 1

Case 7
Arrayseven(Digits) = Arrayseven(Digits) + 1

Case 8
Arrayeight(Digits) = Arrayeight(Digits) + 1

Case 9
Arraynine(Digits) = Arraynine(Digits) + 1

Case 0
Arrayzero(Digits) = Arrayzero(Digits) + 1

End Select

Next Digits

Next Colcells
Next Step



Worksheets(2).Range("C5").Value = Arrayone(1)
Worksheets(2).Range("C6").Value = Arraytwo(1)
Worksheets(2).Range("C7").Value = Arraythree(1)
Worksheets(2).Range("C8").Value = Arrayfour(1)
Worksheets(2).Range("C9").Value = Arrayfive(1)
Worksheets(2).Range("C10").Value = Arraysix(1)
Worksheets(2).Range("C11").Value = Arrayseven(1)
Worksheets(2).Range("C12").Value = Arrayeight(1)
Worksheets(2).Range("C13").Value = Arraynine(1)
Worksheets(3).Range("C5").Value = Arrayzero(2)
Worksheets(3).Range("C6").Value = Arrayone(2)
Worksheets(3).Range("C7").Value = Arraytwo(2)
Worksheets(3).Range("C8").Value = Arraythree(2)
Worksheets(3).Range("C9").Value = Arrayfour(2)
Worksheets(3).Range("C10").Value = Arrayfive(2)
Worksheets(3).Range("C11").Value = Arraysix(2)
Worksheets(3).Range("C12").Value = Arrayseven(2)
Worksheets(3).Range("C13").Value = Arrayeight(2)
Worksheets(3).Range("C14").Value = Arraynine(2)
Worksheets(4).Select
Range("d3").Select
For I = 10 To 99
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Arraytwotest(I)
Next I

Worksheets(2).Select
End Sub

 

[Weaver]

Point being is I can make it do what you need no problem, I just need it to run through in order to test it and the current data set is making it throw a wobbly for some reason, which I can probably fix too if I have some idea of what's intended.

 

[Shultzie]

Benfords Law states that the frequency of numbers can should follow a particular format (i.e., the first digit will be 1 (30+% of the time), and 9 will be the first digit approx 4% of the time). So, when a data set shows that 9 occurs 15% of the time it would indicate that this would need to be investigated. That’s why we’re only interested in the first two digits. <?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>

 

[Shultzie]

here's more info:

http://en.wikipedia.org/wiki/Benford's_law

http://www.journalofaccountancy.com/Issues/2003/Aug/TurnExcelIntoAFinancialSleuth.htm

 

[Weaver]

So it's just the first two then?

This particular line goes through every character

For Digits = 1 To Len(Cells(Colcells, Step))

I think it should be

For Digits = 1 To Len(x)

but this might cause a problem if the original value was say 9.88

because then x = "9."

What I'll do is repost the code modded to get around this issue and once you're satisfied it does what it used to, then I'll address your original issue.

Sound okay?

 

[Shultzie]

Sounds good - I need it to put the results in the same place, so I can still use the graphs and other formulas. Will that be doable?

 

[Weaver]

if the value is less than 10 bucks, say $9.75, do you want to analyse just the 9 or the 9 and the 7?

 

[Shultzie]

If the value is less than $10, then it doesn't evaluate that number (in the original spreadsheet, with two columns, you'll notice there were two numbers < 10 - on the last two results tabs it only evaluated 75 numbers where the first tab evaluated 77 numbers)

 

[Shultzie]

I should say it doesn't evalute numbers < 10 on the two digit test, but it still evaluates them on the first digit test

 

[Weaver]

okay, try this.

BTW, I've not included the ability to modify the column where the data is.

How would you prefer to pass this info to the code?

Sub Benford()
    Dim mainArray(0 To 9, 0 To 9) As Integer
    Dim Arraytwotest(10 To 99) As Integer
    Dim x, I, r, m
    Dim iRow As Long, iCol As Long, iStep As Long, Colcells
    Dim Digits As Long, Total As Long
    iCol = Application.CountA(ActiveSheet.Range("1:1"))
    For iStep = 1 To iCol
        iRow = Cells(1, iStep).End(xlDown).Row
        For Colcells = 1 To iRow
            x = Left(Int(Cells(Colcells, iStep)), 2)
            If x > 9 Then
                Arraytwotest(x) = Arraytwotest(x) + 1
            End If
            For Digits = 1 To Len(x)
                m = Mid(x, Digits, 1)
                mainArray(m, Digits) = mainArray(m, Digits) + 1
            Next Digits
        Next Colcells
    Next iStep
    With Worksheets(2)
        For r = 1 To 9
            .Cells(r + 4, 3).Value = mainArray(r, 1)
        Next r
    End With
    With Worksheets(3)
        For r = 0 To 9
            .Cells(r + 5, 9).Value = mainArray(r, 2)
        Next r
    End With
    With Worksheets(4)
        For I = 10 To 99
            .Cells(I - 7).Value = Arraytwotest(I)
        Next I
    End With
    Worksheets(2).Select
End Sub

 

[Shultzie]

ok, let me try this code on a few data sets, and compare it to the original, and I'll get back to you; should only take a few minutes.