Benford Macro - Please help correct

Shultzie

New Member
Joined
Jan 17, 2009
Messages
38
I'm new to VBA and am using a macro to run a Benford analysis on a data set; the first part of the macro is below - the macro is setup to run in the first column and first row (I know how to adjust the columns and rows; however, there has to be data in the first row for it to run), I'm wanting to adjust it so it will run on my data set in cell E15 (there's several blanks above and some cells with data above - but i want to ignore everything above row 15). Can someone help with this? Thank you in advance.

Here's a portion of the VBA:

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
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Not enough information to be sure of what you want but...
Code:
dim aCell as range
for each acell in range(range("e15"),range("e15").end(xldown))
    'do whatever with aCell
    next aCell
 
Upvote 0
Thanks for the quick response, but I need more help. Here is the entire code. How would I change this so that it targets the data in column E, when the data set varies in length, but always begins in E15?

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
 
Upvote 0
Absolutely fancinating! I knew I should have followed in my father's footsteps (in accounting) instead of getting into IT...

Benford's Law
Benford's law, also called the first-digit law, states that in lists of numbers from many real-life sources of data, the leading digit is distributed in a specific, non-uniform way. According to this law, the first digit is 1 almost one third of the time, and larger digits occur as the leading digit with lower and lower frequency, to the point where 9 as a first digit occurs less than one time in twenty. The basis for this "law" is that the values of real-world measurements are often distributed logarithmically, thus the logarithm of this set of measurements is generally distributed uniformly.

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

So your macro is examing the first digit of each cell in the range.
 
Upvote 0
I too think this macro is great - however, I'm wanting to adjust it so it will do its amazing analysis on a data set that starts somewhere else other than cell A1 - in my case, my data set begins in cell E15, and will only be in column E.
 
Upvote 0
with formulas only

next to the dataset I wrote the formula =left(A2,1) (assuming that your dataset is in column A, starting in row 2. Then copied that down for the whole column

in another section I listed the numbers 1 thru 9 in a column (column AA)
Next to that (column AB) I wrote the formula:
=COUNTIF(RangeReferenceToFormulaColumn,A2) and copied that down for the 9 numbers
Then I totalled that column and named the total cell GrandTotal

Finally, alongside that i wrote the formula
=AB1/GrandTotal

That produces the percentages.

I tried to figure this out with an array formula to eliminate the LEFT() column, but I couldn't figure that out for some odd reason.
 
Upvote 0
hold the presses! I figured out the array formula (all by myself! :) )

With this, you do not need to put the LEFT() formula next to your data column.

Instead,...

Step 1:
In another section I listed the numbers 1 thru 9 in a column (column AA1:AA9)

Step 2:
Next to that, starting in AB1 I wrote the formula:
=SUMPRODUCT(--(VALUE(LEFT(SampleRange,1))=AA1))
(Where SampleRange is your data range. Copy that formula down to AB9)


Step 3:
Then I totalled that column and named the total cell GrandTotal (cell AB10)

Step 4:
Finally, alongside that i wrote the formula
=AB1/GrandTotal
And copy that down to AC9
 
Upvote 0
Lightly tested. Also, all the results are in a single new worksheet. I am not sure why whoever wrote the previous code scattered the results across multiple worksheets but that would make analysis far more difficult.
Code:
Option Explicit
Option Base 0
Sub testBenford()
    Dim DigitCount(9, 9) As Integer 'row is for digit value, col is for digit location
    Dim Arraytwotest(89) As Integer

    
    Dim ColIdx As Long, RowIdx As Long
    
    ColIdx = 5
    
    For RowIdx = Cells(15, ColIdx).Row To Cells(15, ColIdx).End(xlDown).Row
        Dim X As Integer
        X = Left(Cells(RowIdx, ColIdx), 2)
        If X > 9 Then
            Arraytwotest(X - 10) = Arraytwotest(X - 10) + 1
            End If
        
        Dim DigitIdx As Integer
        For DigitIdx = 1 To Len(Cells(RowIdx, ColIdx).Value)
            Dim DigitVal As Integer: DigitVal = CInt(Mid(Cells(RowIdx, ColIdx).Value, DigitIdx, 1))
            DigitCount(DigitVal, DigitIdx - 1) = DigitCount(DigitVal, DigitIdx - 1) + 1
            Next DigitIdx
        
        Next RowIdx
    Dim CurrWS As Worksheet, NewWS As Worksheet
    Set CurrWS = ActiveSheet
    Set NewWS = Worksheets.Add()
    NewWS.Range("c5").Resize(10, 10).Value = DigitCount
    NewWS.Range("c20").Resize(90, 1).Value = Application.WorksheetFunction.Transpose(Arraytwotest)
    End Sub

I too think this macro is great - however, I'm wanting to adjust it so it will do its amazing analysis on a data set that starts somewhere else other than cell A1 - in my case, my data set begins in cell E15, and will only be in column E.
 
Upvote 0

Forum statistics

Threads
1,214,959
Messages
6,122,476
Members
449,087
Latest member
RExcelSearch

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top