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]

I still can't figure out how it worked in its current form! Especially with the number in A43, which is about 15 digits long.

 

[Shultzie]

Ok, I ran your code with two different data sets, and it looks like it works; however, on the Second-digit test it puts the results in column I, instead of column C (it has the right rows though); and on the First-two digits test in puts the results in Row A, beginning in Cell C1 and the results need to go into cells D4:D93.

The First-digit test runs perfect; the results go in exactly the right spot.

You code runs 100 times faster than the original - this is amazing!

If this doesn't make sense I can send you the results I got in an email.

 

[Weaver]

My bad, a typo and a missing digit!

Try:

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, 3).Value = mainArray(r, 2)
        Next r
    End With
    With Worksheets(4)
        For I = 10 To 99
            .Cells(I - 6, 4).Value = Arraytwotest(I)
        Next I
    End With
    Worksheets(2).Select
End Sub

 

[Shultzie]

Perfect!

Now I just need it to work on my data that begins in Cell E15.

 

[Weaver]

and if speed is an issue, insert

application.screenupdating=false

as the first line and

application.screenupdating=true

just before

Worksheets(2).Select

 

[Weaver]

Does benford only work for financials?

 

[Shultzie]

No, it supposed to work with any types of numbers; however, it works best if the numbers are not limited by a range, and the more numbers in the population the more accurate it should be.

Could you also tell me me how to modify the code to begin on cell E15?

Also, do you have any suggestions for a beginners book on VBA?

 

[Weaver]

Try this:

Sub Benford()
    Application.ScreenUpdating = False
    Dim mainArray(0 To 9, 0 To 9) As Integer
    Dim Arraytwotest(10 To 99) As Integer
    Dim x, I, r, m
    Dim firstCell As Range
    Dim iRow As Long, iCol As Long, iStep As Long, Colcells
    Dim Digits As Long, Total As Long
    Dim firstCol, firstRow As Integer
    Set firstCell = ActiveSheet.Range("E15") ' < change to suit
    firstCol = firstCell.Column
    firstRow = firstCell.Row
    iCol = Cells(firstRow, Columns.Count).End(xlToLeft).Column
    For iStep = firstCol To iCol
        iRow = Cells(firstRow, iStep).End(xlDown).Row
        For Colcells = firstRow 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, 3).Value = mainArray(r, 2)
        Next r
    End With
    With Worksheets(4)
        For I = 10 To 99
            .Cells(I - 6, 4).Value = Arraytwotest(I)
        Next I
    End With
    Application.ScreenUpdating = True
    Worksheets(2).Select
End Sub

As for books, I'm not sure, but I've used the Access Bible by these people

http://www.amazon.com/s/ref=nb_ss_gw?url=search-alias=aps&field-keywords=excel+bible&x=0&y=0

US link supplied as your numbers are in dollars!

 

[Shultzie]

Thank you very much - I really appreciate your time; it's truly amazing what Excel can do, and how fast you put this together.

This is awesome!

 

[Weaver]

Thanks for the challenge - it's all experience, and modifying prewritten code is one of the trickier exercises.

BTW, if you order that book, have it delivered to your workplace - it's unlikely to fit through your letter box! Better still get your boss to stump up for it!